Question

我已经编写了宏来循环浏览一个文件夹中的文件（Excel），并从中复制特定的单元格。

我的宏工作正常，但我遇到了一个小问题。宏根据保存日期循环文件，但我需要根据文件名循环它们。有没有办法在宏观中做到这一点？

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

Answer 1

这是一个辅助函数，用于填充和排序使用VBA 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

将可选的第二个参数传递为True将产生字母降序。或者，您可以简单地翻转For ... Next并使其成为步骤-1。

根据名称循环文件

1 个答案: