Sub Macro1()
'
' Macro1 Macro
'
Dim myFiles
Dim i As Long
myFiles = Dir("D:/1/*.xlsx")
On Error Resume Next
Application.ScreenUpdating = True
Application.DisplayAlerts = False
Do While myFiles <> ""
Workbooks.Open Filename:="D:/1/" & myFiles
ActiveWorkbook.SaveAs Filename:= _
"D:/1/" & Left(myFiles, Len(myFiles) - 1), FileFormat:=xlExcel8, _
Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False
ActiveWindow.Close
myFiles = Dir
i = i + 1
DoEvents
Loop
MsgBox "全部轉換完畢，共轉換文件 " & i & "個"
End Sub