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

xlsx文件转换为xls，前提是要在装Excel2007的机器上运行才行。