Sub Test()
Dim wb As Workbook, mPath As String, f As String
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
If Workbooks.Count > 1 Then MsgBox "关闭其他工作簿后再试！": Exit Sub
MsgBox "选择.xlsx文件所在的文件夹！"
With Application.FileDialog(msoFileDialogFolderPicker)
.Show
.AllowMultiSelect = False
If .SelectedItems.Count = 0 Then MsgBox "你放弃了操作！": Exit Sub
mPath = .SelectedItems(1)
End With
f = Dir(mPath & "\*.xlsx")
Do While f <> ""
If f <> ThisWorkbook.Name And Left(f, Len(f) - 1) <> ThisWorkbook.Name Then
Set wb = Workbooks.Open(mPath & "\" & f, , False)
wb.SaveAs Filename:=mPath & "\" & Left(f, Len(f) - 1), FileFormat:=xlExcel8
wb.Close True
Kill mPath & "\" & f
End If
f = Dir
Loop
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
MsgBox "处理完成！"
End Sub