Question

背景
首先，我意识到这对数据库来说是一个完美的任务，但我目前没有这个选项，我认为继续在excel中做这个是一个很好的学习经验。

我有多个工作簿，每个工作簿都包含一个识别号码列表，通过下面的代码输入我需要的工作簿名称，并将列表导入到包含多列数据的主工作簿中。然后我运行我的Match and Export sub将主数据集分成不同的表格。

问题
有没有办法为包含文件夹中的每个文件使用for循环，以便我不必依次识别每个工作簿？

Sub Export_Specified_Contractor()

    Dim listwb As Workbook, mainwb As Workbook
    Dim fname As String
    Dim sht As Worksheet, oput As Worksheet
    Dim LRow As Long, oLRow As Long
    Dim cprng As Range, orng As Range

    '--> Get the name of the contractor list to be exported
    fname = Application.InputBox("Enter Contractor Name", "Name?")

    Set mainwb = ThisWorkbook

    With Application

    '--> Set contractor list file
    Set listwb = .Workbooks.Open _
    ("C:\Documents and Settings\alistairw\My Documents\Disallowed Items\Contractor Lists\" & fname)
    End With

    Set sht = listwb.Sheets("Sheet1")

    '--> Copy contractor list
    With sht
        LRow = .Range("A" & Rows.Count).End(xlUp).Row
        .Range("A1:A" & LRow).Copy
    End With

    mainwb.Activate

    '--> Create contractor list sheet in main workbook and paste values
    With mainwb
        On Error Resume Next
        Sheets("Sheet2").Delete
        Sheets.Add.Name = "Sheet2"
        Set oput = Sheets("Sheet2")
        With oput
            .Range("A1").PasteSpecial
        End With
    End With

    Call Match_and_Export

    '--> Delete the list workbook and list sheet
    Application.DisplayAlerts = False
    listwb.Close
    oput.Delete
    Application.DisplayAlerts = True
End Sub

Answer 1

循环浏览文件夹：

MyPath = "C:\Documents and Settings\alistairw\My Documents\Disallowed Items\Contractor Lists\"
strFilename = Dir(MyPath & "\*.xlsx", vbNormal) 'change to xls if needed

If Len(strFilename) = 0 Then Exit Sub ' exit if no files in folder

Do Until strFilename = ""
    'Your code here
    strFilename = Dir()    
Loop

通过文件夹中的多个工作簿循环命令

1 个答案: