修改VBS - Excel宏循环应用于文件夹中的所有文件 [英] Modify VBS – Excel Macro Loop Apply to all files in folder

问题描述

我有一个脚本将宏应用于多个excel电子表格。下面的代码打开特定的文件名并运行该脚本。我很乐意修改它运行在指定文件夹中的所有xls文件。任何帮助都会很棒！

  Dim objExcel，objWorkbook，xlModule，strCode 
 
如果ReportFileStatus（ C：\Billing\Import\IL\3.xls）=True然后
 OpenFileC：\Billing\Import\IL\3.xls
 
如果ReportFileStatus（C：\Billing\Import\IL\3.xls）=True然后
 OpenFileC：\Billing\Import\IL \3.xls，
 
如果ReportFileStatus（C：\Billing\Import\IL\3.xls）=True然后
 OpenFile C：\Billing\Import\IL\3.xls，
 
如果
 
 
出现错误简历Next 
设置xlModule = Nothing 
 Set objWorkbook = Nothing 
 objExcel.Quit 
 Set objExcel = Nothing 
 On Error GoTo 0 
 
'~~> Sub to打开文件
 Sub OpenFile（sFile，DestFile）
设置objExcel = CreateObject（Excel.Application）
 
 objExcel.Visible = false 
 objExcel.DisplayAlerts =虚假
 
设置objWorkbook = objExcel.Workbooks.Open（sFile）
设置xlModule = objWorkbook.VBProject.VBComponents.Add（1）
 
 strCode = _ 
 Sub MACRO（）& vbCr& _ 
 
'~~>我的宏在这里
 
结束子
 
 xlModule.CodeModule.AddFromString strCode 
 
 
 
 objExcel.Run宏
 
 objWorkbook.Close（False）'< ~~如果要保存更改，请将false更改为true 
 objExcel.Application.Quit 
 End Sub 
 
'~~>函数检查文件是否存在
函数ReportFileStatus（filespec）
 Dim fso，msg 
 
设置fso = CreateObject（Scripting.FileSystemObject）
 
如果（fso.FileExists（filespec））然后
 msg =True
 Else 
 msg =False
如果
 
 ReportFileStatus = msg 
结束函数
  

谢谢

解决方案

这个概念非常简单，给出一个文件夹路径，处理其中的所有文件（或仅基于扩展名的某些文件）以及其子文件夹中的所有文件。最简单的方法是在一个线程中递归子函数和一些全局变量的函数。

接下来要考虑的是导入 .bas文件，而不是尝试向新模块添加文本。您需要先从模块导出工作代码。

以下假定根文件夹为 C：\Billing\Import ，导出的模块.bas文件为 C：\Test\Module1.bas ，您要执行的子名称为 MACRO 。 / p>

  Const sRootFolder =C：\Billing\Import
 Const sExportedModule =C：\Test\\ \\ Module1.bas
 Const sMacroName =MACRO
 
 Dim oFSO，oFDR，oFile'文件和文件夹变量
 Dim oExcel，oWB'Excel变量（应用程序和工作簿） 
 
开始
'------------------------------ 
子开始（）
初始化
 ProcessFilesInFolder sRootFolder 
完成
 End Sub 
'--------------------- --------- 
 Sub ProcessFilesInFolder（sFolder）
'处理此文件夹中的文件
对于每个oFile在oFSO.GetFolder（sFolder）.Files 
如果IsExcelFile（oFile）Then Proc essExcelFile oFile.Path 
下一个
'从此文件夹中重新运行所有子文件夹
对于每个oFDR在oFSO.GetFolder（sFolder）.SubFolders 
 ProcessFilesInFolder oFDR.Path 
 Next 
 End Sub 
'------------------------------ 
 Sub Initialize（） 
设置oFSO = CreateObject（Scripting.FileSystemObject）
设置oExcel = CreateObject（Excel.Application）
 End Sub 
'--------- --------------------- 
 Sub Finish（）
 oExcel.Quit 
设置oExcel = Nothing 
设置oFSO = Nothing 
 End Sub 
'------------------------------ 
函数IsExcelFile（ oFile）
 IsExcelFile =（InStr（1，oFSO.GetExtensionName（oFile），xls，vbTextCompare）> 0）And（Left（oFile.Name，1）<"〜）
结束函数
'------------------- ----------- 
 Sub ProcessExcelFile（sFileName）
 On Error Resume Next 
 wscript.echo处理文件：& sFileName'评论这个，除非在命令提示符下使用cscript 
设置oWB = oExcel.Workbooks.Open（sFileName）
 oWB.VBProject.VBComponents.Import sExportedModule 
 oExcel.Run sMacroName 
 oWB .Close 
 Set oWB = Nothing 
 End Sub 
'----------------------------- -  
  

随时问你是否坚持了解程序流程。

I have a script that applies a macro to multiple excel spreadsheets. The code below opens specific file names and runs the script. I would love to modify this to run on all xls files within a specified folder. Any help would be great!

Dim objExcel, objWorkbook, xlModule, strCode

If ReportFileStatus("C:\Billing\Import\IL\3.xls") = "True" Then
    OpenFile "C:\Billing\Import\IL\3.xls, ""

If ReportFileStatus("C:\Billing\Import\IL\3.xls") = "True" Then
    OpenFile "C:\Billing\Import\IL\3.xls", ""   

If ReportFileStatus("C:\Billing\Import\IL\3.xls") = "True" Then
    OpenFile "C:\Billing\Import\IL\3.xls", ""   

End If


On Error Resume Next
Set xlModule = Nothing
Set objWorkbook = Nothing
objExcel.Quit
Set objExcel = Nothing
On Error GoTo 0

'~~> Sub to open the file
Sub OpenFile(sFile, DestFile)
    Set objExcel = CreateObject("Excel.Application")

    objExcel.Visible = false
    objExcel.DisplayAlerts = False

    Set objWorkbook = objExcel.Workbooks.Open(sFile)
    Set xlModule = objWorkbook.VBProject.VBComponents.Add(1)

    strCode = _
"Sub MACRO()" & vbCr & _

'~~> My Macro Here

"End Sub"

    xlModule.CodeModule.AddFromString strCode



    objExcel.Run "MACRO"

    objWorkbook.Close (False) '<~~ Change false to true in case you want to save changes
    objExcel.Application.Quit
End Sub

'~~> Function to check if file exists
Function ReportFileStatus(filespec)
    Dim fso, msg

    Set fso = CreateObject("Scripting.FileSystemObject")

    If (fso.FileExists(filespec)) Then
        msg = "True"
    Else
        msg = "False"
    End If

   ReportFileStatus = msg
End Function

Thanks

解决方案

The concept is pretty simple, given a folder path, process all files in it (or only certain files based on extension), and all files within it's subfolder. The simplest method is recursive subs and functions with some global variables in a single thread.

The next thing to consider is to Import .bas file instead of trying to add text to a new module. You need to export a working code from a Module first.

Below assumed the root folder to be "C:\Billing\Import", the exported module .bas file is "C:\Test\Module1.bas", and the Sub name you want to execute is "MACRO".

Const sRootFolder = "C:\Billing\Import"
Const sExportedModule = "C:\Test\Module1.bas"
Const sMacroName = "MACRO"

Dim oFSO, oFDR, oFile ' File and Folder variables
Dim oExcel, oWB ' Excel variables (Application and Workbook)

Start    
'------------------------------
Sub Start()
    Initialize
    ProcessFilesInFolder sRootFolder
    Finish
End Sub
'------------------------------
Sub ProcessFilesInFolder(sFolder)
    ' Process the files in this folder
    For Each oFile In oFSO.GetFolder(sFolder).Files
        If IsExcelFile(oFile) Then ProcessExcelFile oFile.Path
    Next
    ' Recurse all sub-folders from this folder
    For Each oFDR In oFSO.GetFolder(sFolder).SubFolders
        ProcessFilesInFolder oFDR.Path
    Next
End Sub
'------------------------------
Sub Initialize()
    Set oFSO = CreateObject("Scripting.FileSystemObject")
    Set oExcel = CreateObject("Excel.Application")
End Sub
'------------------------------
Sub Finish()
    oExcel.Quit
    Set oExcel = Nothing
    Set oFSO = Nothing
End Sub
'------------------------------
Function IsExcelFile(oFile)
    IsExcelFile = (InStr(1, oFSO.GetExtensionName(oFile), "xls", vbTextCompare) > 0) And (Left(oFile.Name, 1) <> "~")
End Function
'------------------------------
Sub ProcessExcelFile(sFileName)
    On Error Resume Next
    wscript.echo "Processing file: " & sFileName ' Comment this unless using cscript in command prompt
    Set oWB = oExcel.Workbooks.Open(sFileName)
    oWB.VBProject.VBComponents.Import sExportedModule
    oExcel.Run sMacroName
    oWB.Close
    Set oWB = Nothing
End Sub
'------------------------------

Feel free to ask if you get stuck understanding the program flow.

这篇关于修改VBS - Excel宏循环应用于文件夹中的所有文件的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！