2010-11-2 16:17
有同事要将上百个xlsx文件转换为xls,于是写了一个原型。
当然前提是要在装Excel2007的机器上运行才行。
01 Sub Macro1()
02 '
03 ' Macro1 Macro
04 '
05 Dim myFiles
06 Dim i As Long
07 myFiles = Dir("D:\1\*.xlsx")
08 On Error Resume Next
09 Application.ScreenUpdating = True
10 Application.DisplayAlerts = False
11 Do While myFiles <> ""
12 Workbooks.Open Filename:="D:\1\" & myFiles
13 ActiveWorkbook.SaveAs Filename:= _
14 "D:\1\" & Left(myFiles, Len(myFiles) - 1), FileFormat:=xlExcel8, _
15 Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
16 CreateBackup:=False
17 ActiveWindow.Close
18 myFiles = Dir
19 i = i + 1
20 DoEvents
21 Loop
22 MsgBox "全部转换完毕,共转换文件 " & i & "个"
23 End Sub
02 '
03 ' Macro1 Macro
04 '
05 Dim myFiles
06 Dim i As Long
07 myFiles = Dir("D:\1\*.xlsx")
08 On Error Resume Next
09 Application.ScreenUpdating = True
10 Application.DisplayAlerts = False
11 Do While myFiles <> ""
12 Workbooks.Open Filename:="D:\1\" & myFiles
13 ActiveWorkbook.SaveAs Filename:= _
14 "D:\1\" & Left(myFiles, Len(myFiles) - 1), FileFormat:=xlExcel8, _
15 Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
16 CreateBackup:=False
17 ActiveWindow.Close
18 myFiles = Dir
19 i = i + 1
20 DoEvents
21 Loop
22 MsgBox "全部转换完毕,共转换文件 " & i & "个"
23 End Sub
原型代码。文件固定在D:\1目录了,可以进一步改进并增加对子目录的支持。
