在一个文件夹下，如何批量转换xls到xlsx的格式

久久90

批量转换，不是一个一个转换哈

lsc900707

亲，代码测试不正确，删除。

久久90

我在网上找了个
XLS转换XLSX
Sub fdgdfs()
Application.ScreenUpdating = 0
Application.DisplayAlerts = 0
Dim fs, fold, fls, fl
Set fs = CreateObject("Scripting.FileSystemObject")
Set fold = fs.getfolder(ThisWorkbook.Path) 'folderpath指文件夹路径，string型，实践中自行替换
Set fls = fold.Files
For Each fl In fls
If InStr(fl.Name, ".xls") <> 0 And Right(fl.Name, 3) = "xls" Then '避免打开非Excel文
Workbooks.Open (ThisWorkbook.Path & "\" & fl.Name)
ActiveWorkbook.SaveAs Filename:= _
ThisWorkbook.Path & "\" & Left(fl.Name, Len(fl.Name) - 4) & ".xlsx", FileFormat:= _
xlOpenXMLWorkbook, CreateBackup:=False
ActiveWorkbook.Close
End If
Next
Application.ScreenUpdating = 1
Application.DisplayAlerts = 1
End Sub
感觉还可以

久久90

lsc900707 发表于 2016-7-31 21:55
亲，请复制代码并测试:
Sub abc()
Dim strFilePath As String, strFileName As String, strFileType As  ...

这个在网上也找过，不过貌似选择文件夹后就没有结果了，你试了没

jiminyanyan

lsc900707 发表于 2016-7-31 21:55
亲，请复制代码并测试:
Sub abc()
Dim strFilePath As String, strFileName As String, strFileType As  ...

如有宏，转成xlsx可能不是很恰当。

lsc900707

jiminyanyan 发表于 2016-7-31 22:10
如有宏，转成xlsx可能不是很恰当。

是呀，所以我一直没测试过。

lsc900707

久久90 发表于 2016-7-31 22:00
这个在网上也找过，不过貌似选择文件夹后就没有结果了，你试了没

收藏好久了，但从没测试过。因为我很久就没用97~03版的office了。
没帮到你，实在抱歉！

jiminyanyan

1. Sub 批量转换工作簿()
   
2.     '变量声明
   
3.     Dim oPath        As String   '原始文件路径
   
4.     Dim oFName      As String   '原始文件名
   
5.     Dim dPath        As String   '目标文件路径
   
6.     Dim dFName      As String   '目标文件名
   
7.     '获取路径
   
8.     oPath = ThisWorkbook.Path & "\原工作簿"
   
9.     dPath = ThisWorkbook.Path & "\转换结果"
   
10.     '打开工作簿时强制禁止宏
    
11.     Application.AutomationSecurity = msoAutomationSecurityForceDisable
    
12.     '禁用警告
    
13.     Application.DisplayAlerts = False
    
14.     '查找xls文件
    
15.     oFName = Dir(oPath & "*.xls")
    
16.     '当文件被找到则不断循环
    
17.     Do While oFName <> ""
    
18.         '打开工作簿
    
19.         With Workbooks.Open(oPath & oFName)
    
20.             '判断工作簿是否含有VB工程
    
21.             If .HasVBProject Then
    
22.                 '若含有VB工程，则另存为启用宏的工作簿
    
23.                 dFName = oFName & "m"
    
24.                 .SaveAs dPath & dFName, xlOpenXMLWorkbookMacroEnabled
    
25.             Else
    
26.                 '若不含有VB工程，则另存为一般工作簿
    
27.                 dFName = oFName & "x"
    
28.                 .SaveAs dPath & dFName, xlOpenXMLWorkbook
    
29.             End If
    
30.             '关闭工作簿
    
31.             .Close False
    
32.         End With
    
33.         '查找下一个文件
    
34.         oFName = Dir
    
35.     Loop
    
36.     '恢复打开文件的宏安全性设置
    
37.     Application.AutomationSecurity = msoAutomationSecurityByUI
    
38.     '启用警告
    
39.     Application.DisplayAlerts = True
    
40. End Sub
    

复制代码

jiminyanyan

lsc900707 发表于 2016-7-31 22:13
是呀，所以我一直没测试过。

看8楼。。。。。。。

lsc900707

jiminyanyan 发表于 2016-7-31 22:36
看8楼。。。。。。。

谢谢，亲测OK.我要更新收藏工具了。