如何为文件名添加变量?

时间:2018-08-23 08:45:28

标签: excel vba

我找到了可以工作的代码。

如何为包含通配符的文件名添加变量?

已为文件名设置了一个变量,但由于一些较旧的文件名称略有不同,因此具有一定的局限性。

我正在努力将变量与通配符混合。

变量为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

0 个答案:

没有答案