VBA遍历文件夹中的excel工作簿并复制数据-不遍历所有文件

Question

我正在尝试获取VBA宏以遍历特定文件夹中的所有xls文件。以下代码大部分有效。但是，我在此文件夹中有42个文件，并且代码仅循环通过其中的26个文件。它们都是相同的文件扩展名。

我的想法是不是没有遍历所有文件。或它正在遍历所有文件，但是最后一行变量存在问题，并且正在粘贴数据。

Sub CopyDataBetweenWorkbooks()

    Dim wbSource As Workbook
    Dim shTarget As Worksheet
    Dim shSource As Worksheet
    Dim strFilePath As String
    Dim strPath As String

Application.ScreenUpdating = False

    ' Initialize some variables and
    ' get the folder path that has the files
    Set shTarget = ThisWorkbook.Sheets(1)
    strPath = GetPath

    ' Make sure a folder was picked.
    If Not strPath = vbNullString Then

        ' Get all the files from the folder
        strfile = Dir$(strPath & "*.xls", vbNormal)

        Do While Not strfile = vbNullString

            ' Open the file and get the source sheet
            Set wbSource = Workbooks.Open(strPath & strfile)
            Set shSource = wbSource.Sheets("Trend Report")


            'Copy the data
            Call CopyData(shSource, shTarget)

            'Close the workbook and move to the next file.
            wbSource.Close False
            strfile = Dir$()
        Loop
    End If

End Sub

' Procedure to copy the data.
Sub CopyData(ByRef shSource As Worksheet, shTarget As Worksheet)

    LastRowSource = shSource.Cells(Rows.Count, "B").End(xlUp).Row
    Dim strRANGE_ADDRESS As String
    Dim lastrow As String
    strRANGE_ADDRESS = "B15:H" & LastRowSource - 1

    'insert file name
    StrFileFullname = ActiveWorkbook.FullName
    shSource.Range("H15:H" & LastRowSource).Value = StrFileFullname

    'Copy the data.
    shSource.Range(strRANGE_ADDRESS).Copy

    'Set last row and paste
    lastrow = shTarget.Cells(Rows.Count, "B").End(xlUp).Row + 1

    shTarget.Range("B" & lastrow).PasteSpecial xlPasteValuesAndNumberFormats

    ' Reset the clipboard.
    Application.CutCopyMode = xlCopy

End Sub


' Function to get the folder path
Function GetPath() As String

    With Application.FileDialog(msoFileDialogFolderPicker)
        .ButtonName = "Select a folder"
        .Title = "Folder Picker"
        .AllowMultiSelect = False

        'Get the folder if the user does not hot cancel
        If .Show Then GetPath = .SelectedItems(1) & "\"

    End With

End Function