excel自动获取vbscript数据之前的使用VBA实现的多文件相互sheet拷贝。在实践中，发现文件的数量越多，文件的大小越大，VBA工具越不稳定。这主要是因为VBA不够稳定，而且非常耗费内存。更改为VBScript后，性能问题大为改善。基本不需要人工干预了。另外有一些对象没有关闭，虽不影响执行，但是会产生一些内存垃圾。代码'标注必须显示声明各种变量OptionExplicit'声明变量的时候，不需要类型。
excel自动获取vbscript数据?之前的【工作拾遗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 ifobjExcel.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 currentPathDim fso Dim folder Dim files Dim basefolder Dim subFolders Dim fileIf 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" ThenSet tempWorkbook = objExcel.Workbooks.Open(folderPath & fileName)Dim isExist isExist = FalseIf worksheetExists("EventDefinition", tempWorkbook) Or worksheetExists("DBMapping(R)", tempWorkbook) Or _ worksheetExists("DBMapping(CUD)", tempWorkbook) Or worksheetExists("Master", tempWorkbook) Then isExist = True End IfIf isExist Then tempWorkbook.Close ElseDim 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.ClosewriteLog objLogfile, "############## " & folderPath & fileName & "executed ##############" End If End If Next ' 递归 Set subFolders = basefolder.subFoldersFor Each folder In subFoldersLoopAllSubFolders folder.path, templateNextEnd 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) ThenIsExitAFile=TrueElse IsExitAFile=FalseEnd IfEnd Function' 删除文件Sub DeleteAFile(filespec) Dim fso Set fso= CreateObject("Scripting.FileSystemObject") fso.DeleteFile(filespec)End Sub
