Sub 批量另存为()
Application.ScreenUpdating = False
Dim pppath, xlsht, xlwb, xlpath, m, n, i
d = ThisWorkbook.Path
Dim b, c
c = 0
For Each f In CreateObject("scripting.FileSystemObject").GetFolder(d).Files
If f.Name = "xls批量另存为 .xlsm" Then f = f + 1
If f.Name Like "*.xls" Then c = c + 1
Workbooks.Open Filename:=f, UpdateLinks:=0
ActiveWorkbook.SaveAs Filename:=d & "\" & Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 4), FileFormat:=xlOpenXMLWorkbook
ActiveWindow.Close
Next
If c = 0 Then
MsgBox "该文件夹内无xlsx格式的文件"
Exit Sub
End If
Application.ScreenUpdating = True
End Sub
Application.ScreenUpdating = False
Dim pppath, xlsht, xlwb, xlpath, m, n, i
d = ThisWorkbook.Path
Dim b, c
c = 0
For Each f In CreateObject("scripting.FileSystemObject").GetFolder(d).Files
If f.Name = "xls批量另存为 .xlsm" Then f = f + 1
If f.Name Like "*.xls" Then c = c + 1
Workbooks.Open Filename:=f, UpdateLinks:=0
ActiveWorkbook.SaveAs Filename:=d & "\" & Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 4), FileFormat:=xlOpenXMLWorkbook
ActiveWindow.Close
Next
If c = 0 Then
MsgBox "该文件夹内无xlsx格式的文件"
Exit Sub
End If
Application.ScreenUpdating = True
End Sub