复制代码

　　代码如下:

　　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的机器上运行才行。