标签:
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
标签:
原文地址:http://www.cnblogs.com/mahocon/p/5724901.html