VBA Sortieren DIR, um Daten in alphabetischer Reihenfolge zu übertragen

Question

Ich habe ein Makro geschrieben, um Daten aus allen Arbeitsmappen in einem benutzerdefinierten Ordner in ein Masterdokument zu kopieren und einzufügen, jedoch wählt das Makro derzeit die Dateien in zufälliger Reihenfolge aus. Ich möchte die Dateien in alphabetischer Reihenfolge auswählen, damit die Daten im Master-Dokument in der richtigen Reihenfolge angezeigt werden ... Helfen Sie, dies zu erreichen, sehr geschätzt, ich bin nicht wert auf die Methode!

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 

Answer 1

Werfen Sie einen Blick auf das folgende Beispiel zeigt, wie Sie können mit Filterschleife durch die Dateien im Ordner und Shell.Application mit Hilfe von ActiveX in alphabetischer Reihenfolge sortiert:

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