excel自动获取vbscript数据（使用VBScript实现多Excel文件相互sheet拷贝等操作）

导读之前的【工作拾遗2VBA工具实现Module和Sheet的拷贝及按钮绑定宏】使用VBA实现的多文件相互sheet拷贝在实践中，发现文件的数量越多，文件的大小....

之前的【工作拾遗2 VBA工具实现Module和Sheet的拷贝及按钮绑定宏】使用VBA实现的多文件相互sheet拷贝在实践中，发现文件的数量越多，文件的大小越大，VBA工具越不稳定经常会出现各种奇怪的问题出现问题的时候， 就需要手工干预这主要是因为VBA不够稳定，而且非常耗费内存更改为VBScript后，性能问题大为改善 基本不需要人工干预了，今天小编就来聊一聊关于excel自动获取vbscript数据?接下来我们就一起去研究一下吧!

excel自动获取vbscript数据

之前的【工作拾遗2 VBA工具实现Module和Sheet的拷贝及按钮绑定宏】使用VBA实现的多文件相互sheet拷贝。在实践中，发现文件的数量越多，文件的大小越大，VBA工具越不稳定。经常会出现各种奇怪的问题。出现问题的时候， 就需要手工干预。这主要是因为VBA不够稳定，而且非常耗费内存。更改为VBScript后，性能问题大为改善。 基本不需要人工干预了。

涉及到的功能

使用VBS操作Excel的Sheet，Module，打开，保存，关闭等

输出log

取得当前文件夹

文件的基本操作，追加模式，建立文件，判断存在，删除等

可参照之前的VBA实现的相同功能，对比一下不同。另外有一些对象没有关闭，虽不影响执行，但是会产生一些内存垃圾。作者比较懒，先不修正了。

代码

标注必须显示声明各种变量 Option Explicit 声明变量的时候，不需要类型。否则会出编译错误 Dim objExcel Dim currentPath Dim templateWorkbook Dim jsonConverter Dim loadAdip Dim util Dim objFSO Dim objLogfile 建立很常用的fso对象，用来操作普通文件 Set objFSO = CreateObject("Scripting.FileSystemObject") 建立Excel对象 Set objExcel = CreateObject("Excel.Application") 取得当前文件夹 currentPath = objFSO.GetFolder(".").Path 追加模式打开/建立log文件 Set objLogfile = objFSO.OpenTextFile(currentPath & "AddDDSheet.log", 8, True) 上一章讲过，不显示警告对话框 objExcel.DisplayAlerts = False 输出log writeLog objLogfile, "############## Start ##############" 取得需要拷贝的Sheet存在的模板文件 Set templateWorkbook = objExcel.Workbooks.Open(currentPath & "CopyFrom.xlsm") 取得需要拷贝的Module，从文件中导出到当前文件夹 module1 = currentPath & "module1.bas" templateWorkbook.VBProject.VBComponents("module1").Export jsonConverter 递归调用sub，实现将Sheet和Module拷贝到当前文件夹files下所有Excel文件中 这里需要注意，只有扩展名为xlsm的Excel文件才能接收Module LoopAllSubFolders currentPath & "files", templateWorkbook 关闭模板文件 templateWorkbook.Close() 将刚才导出的module删除 If IsExitAFile(module1) Then DeleteAFile(module1) END if objExcel.DisplayAlerts = True Set objExcel = nothing writeLog objLogfile, "############## End ##############" objLogfile.close() Set objFSO = Nothing Set objLogfile = Nothing msgbox("Execution over") 递归调用的sub，也是主要功能模块Sub LoopAllSubFolders(folderPath, template) Dim fileName Dim fullFilePath Dim tempWorkbook Dim tempWorksheet Dim currentPath Dim fso Dim folder Dim files Dim basefolder Dim subFolders Dim file If Right(folderPath, 1) <> "" Then folderPath = folderPath & "" Set fso = CreateObject("Scripting.FileSystemObject") Set basefolder = fso.GetFolder(folderPath) For Each file In basefolder.files fileName = file.Name excel files only If Right(fileName, 5) = ".xlsx" Or Right(fileName, 5) = ".xlsm" Then Set tempWorkbook = objExcel.Workbooks.Open(folderPath & fileName) Dim isExist isExist = False If worksheetExists("EventDefinition", tempWorkbook) Or worksheetExists("DBMapping(R)", tempWorkbook) Or _ worksheetExists("DBMapping(CUD)", tempWorkbook) Or worksheetExists("Master", tempWorkbook) Then isExist = True End If If isExist Then tempWorkbook.Close Else Dim module1 module1 = currentPath & "module1.bas" 导入module到目标文件 If IsExitAFile(module1) Then tempWorkbook.VBProject.VBComponents.Import module1 拷贝多个Sheet到目标文件 这里要注意，Copy方法有两个参数，第一个是Before，第二个是After，想指定拷贝到某个Sheet之前，需要用第一个， 否则需要用第二个。 这里用的第二个， 所以第一个参数是空的，第二个参数和空的第一个参数之间用逗号间隔 template.Worksheets(Array("Sheet1", "Sheet2", "Sheet3", "Sheet4")).Copy , tempWorkbook.Worksheets(tempWorkbook.Worksheets.Count) 将module中的宏绑定到按钮上 tempWorkbook.Worksheets("Sheet1").Shapes("Button 1").OnAction = tempWorkbook.Name & "!Module1.execute" 保存文件 tempWorkbook.Save 关闭文件 tempWorkbook.Close writeLog objLogfile, "############## " & folderPath & fileName & "executed ##############" End If End If Next 递归 Set subFolders = basefolder.subFolders For Each folder In subFolders LoopAllSubFolders folder.path, template NextEnd Sub 判断Sheet是否存在Function worksheetExists(shtName, wb) Dim sht worksheetExists = False For Each sht In wb.Worksheets If sht.Name = shtName Then worksheetExists = True exit for End if NextEnd Function 输出logSub writeLog(objLogfile, str) objLogfile.WriteLine FormatDateTime(Now(), 1) & _ " " & FormatDateTime(Now(), 3) & " " & strEnd Sub 判断文件是否存在Function IsExitAFile(filespec) Dim fso Set fso=CreateObject("Scripting.FileSystemObject") If fso.fileExists(filespec) Then IsExitAFile=True Else IsExitAFile=False End IfEnd Function 删除文件Sub DeleteAFile(filespec) Dim fso Set fso= CreateObject("Scripting.FileSystemObject") fso.DeleteFile(filespec)End Sub