我找到了可以工作的代码。
如何为包含通配符的文件名添加变量?
已为文件名设置了一个变量,但由于一些较旧的文件名称略有不同,因此具有一定的局限性。
我正在努力将变量与通配符混合。
变量为SelectedReport,所有报告均以相同的3个字母开头,后跟相同的3位数字“ REP009”,这超出了文件名出错的初始报告编号。
如何为导出的文件名添加变量?
Sub RecursiveFileSearch(ByVal targetFolder As String, ByRef objRegExp As Object, _
ByRef matchedFiles As Collection, ByRef objFSO As Object)
Dim objFolder As Object
Dim objFile As Object
Dim objSubFolders As Object
'Get the folder object associated with the target directory
Set objFolder = objFSO.GetFolder(targetFolder)
'Loop through the files current folder
For Each objFile In objFolder.Files
If objRegExp.test(objFile) Then
matchedFiles.Add (objFile)
End If
Next
'Loop through the each of the sub folders recursively
Set objSubFolders = objFolder.Subfolders
For Each objSubfolder In objSubFolders
RecursiveFileSearch objSubfolder, objRegExp, matchedFiles, objFSO
Next
'Garbage Collection
Set objFolder = Nothing
Set objFile = Nothing
Set objSubFolders = Nothing
End Sub
Function FindPatternMatchedFiles(sPath As String) As Collection
Dim objFSO As Object
Set objFSO = CreateObject("Scripting.FileSystemObject")
Dim objRegExp As Object
Dim SelectedReport As String
SelectedReport = Worksheets("Sheet1").Cells(2, "B").Value
Set objRegExp = CreateObject("VBScript.RegExp")
' new line with filename
objRegExp.Pattern = SelectedReport
objRegExp.IgnoreCase = True
Dim colFiles As Collection
Set colFiles = New Collection
RecursiveFileSearch sPath, objRegExp, colFiles, objFSO
'Garbage Collection
Set objFSO = Nothing
Set objRegExp = Nothing
Set FindPatternMatchedFiles = colFiles
End Function
Sub MergeWorkbooks(sPath As String, sWbName As String)
Dim colFiles As Collection
Set colFiles = FindPatternMatchedFiles(sPath)
Dim appExcel As New Excel.Application
appExcel.Visible = False
Dim wbDest As Excel.Workbook
Set wbDest = appExcel.Workbooks.Add()
Dim wbToAdd As Excel.Workbook
Dim sheet As Worksheet
For Each file In colFiles
Set wbToAdd = appExcel.Workbooks.Open(file)
For Each sheet In wbToAdd.Sheets
sheet.Copy Before:=wbDest.Sheets(wbDest.Sheets.Count)
Next sheet
wbToAdd.Close SaveChanges:=False
Next
wbDest.Close True, sPath + "\" + sWbName
Set wbDest = Nothing
Set appExcel = Nothing
End Sub
Sub Main()
MergeWorkbooks "C:\Path\To\Folder", "Awesomeness.xlsx"
End Sub