使用VBScript 遍历根目录下所有文件夹的excel并格式化为其他excel格式

本文链接：https://blog.youkuaiyun.com/nanqu2090/article/details/77985071

使用VBScript编写脚本，遍历指定根目录下所有.xls文件，将其转换为其他格式，如98-2003的.xls格式。代码通过SaveAs方法实现转换，并列出各种Excel文件格式的值和描述。

摘要生成于 C知道，由 DeepSeek-R1 满血版支持，前往体验 >

 'write by shawn in 2017/09/14 
Dim oFso,now_current_path,CurrentPath_Now,oSubFolders,Filename,Filename2,Count
Set oFso = CreateObject("Scripting.FileSystemObject")    
Set CurrentPath_Now = oFso.GetFolder(".") 
Function FilesTree(sPath)    
    'return this folder's all folders    
    Set oFso = CreateObject("Scripting.FileSystemObject")    
    Set oFolder = oFso.GetFolder(sPath)    'return this folder's object
    Set oSubFolders = oFolder.SubFolders    'return this folder's all son folder        
    Set oFiles = oFolder.Files    
    For Each oFile In oFiles 
	Set oFso2 = CreateObject("Scripting.FileSystemObject")        
		'Wscript.echo CStr(oFso2.GetExtensionName(oFile.Path))
		Filename = CStr(oFso2.GetExtensionName(oFile.Path))
		if (Filename = "XLS")Or(Filename = "xls") Then
              Set oExcel=CreateObject("excel.application")  
              Set oWorkBook=oExcel.Workbooks.Open(oFile)  
		      Set oSheet=oWorkBook.Sheets(1) 'get first sheet in excel
			  Wscript.echo oFile
			   oSheet.SaveAs ""&(Left(oFile,(Len(oFile)-4))&"new"&".xls")&"",18 
			   Set oSheet=Nothing
              Set oWorkBook=Nothing			  
              oExcel.Quit              
        End if
		Set Filename=Nothing
    Set	oFso2 = Nothing
    Next           
    For Each oSubFolder In oSubFolders   
    Set oFso3 = CreateObject("Scripting.FileSystemObject")	
	'Wscript.echo CStr(oFso3.GetExtensionName(oSubFolder.Path))
	  Filename2 = CStr(oFso3.GetExtensionName(oSubFolder.Path))  
		if (Filename2 = "XLS")Or(Filename2 = "xls") Then
              Set oExcel=CreateObject("excel.application")  
              Set oWorkBook=oExcel.Workbooks.Open(oSubFolder)  
              Set oSheet=oWorkBook.Sheets(1) 'get first sheet in excel
              oSheet.SaveAs ""&("D:\"&Left(oSubFolder,(Len(oSubFolder)-4))&"new"&".xls")&"",18 
              Set oSheet=Nothing  
              Set oWorkBook=Nothing			  
              oExcel.Quit              
        End if
		Set Filename2=Nothing
        FilesTree(oSubFolder.Path)  '递归  
    Set	oFso2 = Nothing		
    Next        
    Set oFolder = Nothing    
    Set oSubFolders = Nothing    
    Set oFso = Nothing    
End Function    
	FilesTree(CurrentPath_Now)
Set oFso = Nothing
Set now_current_path = Nothing
Set oSubFolders =Nothing

其中SaveAs 方法参数分别为新的文件全路径，以及指定的转化格式，上述代码中的18代表98-2003老格式的excel文件

放在目标文件夹下自动获取当前路径，执行格式转化，代码中自动转化 ' .xls '格式的excel文件

附转化表：

名称值描述
xlAddIn 18 Microsoft Office Excel 加载项
xlAddIn8 18 Excel 2007 加载项
xlCSV 6 CSV
xlCSVMac 22 Macintosh CSV
xlCSVMSDOS 24 MSDOS CSV
xlCSVWindows 23 Windows CSV
xlCurrentPlatformText -4158 当前平台文本
xlDBF2 7 DBF2
xlDBF3 8 DBF3
xlDBF4 11 DBF4
xlDIF 9 DIF
xlExcel12 50 Excel 12
xlExcel2 16 Excel 2
xlExcel2FarEast 27 Excel2 FarEast
xlExcel3 29 Excel3
xlExcel4 33 Excel4
xlExcel4Workbook 35 Excel4 工作簿
xlExcel5 39 Excel5
xlExcel7 39 Excel7
xlExcel8 56 Excel8
xlExcel9795 43 Excel9795
xlHtml 44 HTML 格式
xlIntlAddIn 26 国际加载项
xlIntlMacro 25 国际宏
xlOpenXMLAddIn 55 打开 XML 加载项
xlOpenXMLTemplate 54 打开 XML 模板
xlOpenXMLTemplateMacroEnabled 53 打开启用的 XML 模板宏
xlOpenXMLWorkbook 51 打开 XML 工作簿
xlOpenXMLWorkbookMacroEnabled 52 打开启用的 XML 工作簿宏
xlSYLK 2 SYLK
xlTemplate 17 模板
xlTemplate8 17 模板 8
xlTextMac 19 Macintosh 文本
xlTextMSDOS 21 MSDOS 文本
xlTextPrinter 36 打印机文本
xlTextWindows 20 Windows 文本
xlUnicodeText 42 Unicode 文本
xlWebArchive 45 Web 档案
xlWJ2WD1 14 WJ2WD1
xlWJ3 40 WJ3
xlWJ3FJ3 41 WJ3FJ3
xlWK1 5 WK1
xlWK1ALL 31 WK1ALL
xlWK1FMT 30 WK1FMT
xlWK3 15 WK3
xlWK3FM3 32 WK3FM3
xlWK4 38 WK4
xlWKS 4 工作表
xlWorkbookDefault 51 默认工作簿
xlWorkbookNormal -4143 常规工作簿
xlWorks2FarEast 28 Works2 FarEast
xlWQ1 34 WQ1
xlXMLSpreadsheet 46 XML 电子表格