VBA Sort DIR to transfer data in alphabetical order

问题

I have written a macro below to copy and paste data from all workbooks within a user selected folder into a master document, however currently the macro selects the files in a random order. What I want to do is for it to select the files in alphabetical order, so the data in the master document is in the correct order... Help achieving this would be much appreciated, I am not precious about the method!

Sub Import_Data()

    ' PURPOSE: To loop through all Excel files in a user specified folder and perform a set task on them

    Dim WB As Workbook
    Dim wbThis As Workbook
    Dim myPath As String
    Dim myFile As String
    Dim myExtension As String
    Dim FldrPicker As FileDialog

    Set wbThis = ActiveWorkbook

    ' Optimize Macro Speed
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual

    ' Retrieve Target Folder Path From User
    MsgBox "Please select Faro Scan Data Folder"

    Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)
    With FldrPicker
        .Title = "Select A Target Folder"
        .AllowMultiSelect = False
        If .Show <> -1 Then GoTo NextCode
        myPath = .SelectedItems(1) & "\"
    End With

    ' In Case of Cancel
NextCode:
    myPath = myPath
    If myPath = "" Then GoTo ResetSettings

    ' Target File Extension (must include wildcard "*")
    myExtension = "*.xls"

    ' Target Path with Ending Extention
    myFile = Dir(myPath & myExtension)

    ' Loop through each Excel file in folder
    Do While myFile <> ""

        ' Set variable equal to opened workbook
        Set WB = Workbooks.Open(Filename:=myPath & myFile)

        ' Ensure Workbook has opened before moving on to next line of code
        DoEvents

        ' Copy data from target workbook....
        WB.Activate
        Application.CutCopyMode = False
        Range("D8:D377").Copy
        wbThis.Activate
        Sheets("Faro Scan Data").Select
        Range("E5").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        Application.CutCopyMode = False

        ' Insert column for next data set
        Columns("E:E").Select
        Selection.Insert Shift:=xlToRight

        ' Format column for new dataset
        Columns("I:I").Select
        Selection.Copy
        Columns("E:E").Select
        Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
        Application.CutCopyMode = False

        ' Close Workbook
        WB.Close SaveChanges:=False

        ' Ensure Workbook has closed before moving on to next line of code
        DoEvents

        ' Get next file name
        myFile = Dir
    Loop

    ' Message Box when tasks are completed
    MsgBox "Task Complete!"

ResetSettings:
    ' Reset Macro Optimization Settings
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True

    MsgBox "Remeber to enter column headings!"

End Sub

回答1:

Take a look at the below example showing how you can loop through files in folder with filter and sorted in alphabetical order using Shell.Application ActiveX:

Option Explicit

Sub Test_Shell_Folder_Items()

    Dim sPath
    Dim sExtension
    Dim oShellApp
    Dim oFolder
    Dim oFolderItems
    Dim oFolderItem

    sPath = "C:\Test"
    sExtension = "*.xls"

    Set oShellApp = CreateObject("Shell.Application")
    Set oFolder = oShellApp.Namespace(sPath)
    Set oFolderItems = oFolder.Items()
    oFolderItems.Filter 64 + 128, sExtension ' 32 - folders, 64 - not folders, 128 - hidden
    For Each oFolderItem In oFolderItems
        Debug.Print oFolderItem.Path
    Next

End Sub

来源：https://stackoverflow.com/questions/43477951/vba-sort-dir-to-transfer-data-in-alphabetical-order