Loop files according to name

问题

I have written macro for looping through the files (Excels) in one folder and copy specific cells from it.

My macro is working as it should but I have a small problem. Macro is looping files according to save date but I need to loop them according to file name. Is there any way how to make this in macro?

Public Sub Data_copy()
'DECLARE AND SET VARIABLES
Dim wbk As Workbook
Dim Filename As String
Dim Path As String

Path = "U:\KST\Antrag\"  'PATH
Filename = Dir(Path & "*.xlsm")
'--------------------------------------------
'OPEN EXCEL FILES
 Do While Len(Filename) > 0  'IF NEXT FILE EXISTS THEN
    Set wbk = Workbooks.Open(Path & Filename)

    With ActiveWorkbook
    Sheets("Form").Select
    Range("O4:W4").Select
    End With

    Selection.Copy
    Windows("Seznam_KST.xlsm").Activate
    Sheets("List1").Select
    Range("H" & ActiveCell.Row + 1).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    wbk.Close True
    Filename = Dir
Loop
End Sub

回答1:

Here is a helper function to stuff and sort a variant array of filenames retrieved with VBA's Dir function.

Sub run_sorted_dir()
    Dim v As Long, vFILES As Variant, fm As String, fp As String

    fp = "c:\users\user\Documents"
    fm = fp & Chr(92) & "*.xl*"
    Debug.Print fm
    vFILES = dirSorted(fm, False)
    For v = LBound(vFILES) To UBound(vFILES)
        'you will need to put the path back into
        'but the filenames are sorted at this point
        Debug.Print fp & Chr(92) & vFILES(v)
    Next v

End Sub

Function dirSorted(filemask As String, Optional bDescending As Boolean = False)
    Dim v As Long, w As Long, vDIR As Variant, sTMP As String

    ReDim vDIR(1 To 1)

    vDIR(UBound(vDIR)) = Dir(filemask)
    Do While CBool(Len(vDIR(UBound(vDIR))))
        ReDim Preserve vDIR(1 To UBound(vDIR) + 1)
        vDIR(UBound(vDIR)) = Dir
    Loop
    ReDim Preserve vDIR(1 To UBound(vDIR) - 1)

    For v = LBound(vDIR) To UBound(vDIR) - 1
        For w = v + 1 To UBound(vDIR)
            sTMP = vDIR(v)
            If (LCase(vDIR(v)) < LCase(vDIR(w)) And bDescending) Or _
               (LCase(vDIR(v)) > LCase(vDIR(w)) And Not bDescending) Then
                vDIR(v) = vDIR(w)
                vDIR(w) = sTMP
            End If
        Next w
    Next v

    dirSorted = vDIR

End Function

Passing the optional second parameter in as True will produce an alphabetic descending order. Alternately you could simply flip the For ... Next and make it a Step -1.

来源：https://stackoverflow.com/questions/31376702/loop-files-according-to-name

标签

excel

vba

while-loop