Question

我正在尝试从具有相同前缀的目录中的所有Excel文件导入数据。数据将从这些文件聚合并写入主文件。我已经成功地制作了一个do while脚本，可以使用带有通配符的DIR识别三个测试文件。但是，当我添加命令以打开文件（并立即关闭它）时，在打开和关闭文件后第一次传递后，do do失败。注释掉open和close命令以及do while循环，循环三次识别测试文件。最后，我想通过调用sub来替换open / close命令，该sub将打开文件，聚合数据并将其写入主文件。我提到这个，以防它改变了编码方式。我搜索了论坛，发现了其他一些方法来完成我的一些目标，但不是全部。一个例子是文件名中的通配符。任何帮助表示赞赏。

Sub LoopThroughFiles()

Dim strName As String
Dim strPath As String
Dim strFile As String


strPath = ThisWorkbook.Path
strName = "Employee Gross Sales"
strFile = Dir(strPath & "\" & strName & "*")

Do While Len(strFile) > 0
    Debug.Print strFile
'   Call OpenFile(strPath, strFile) <-- Eventually will replace open / close commands below

    Workbooks.Open FileName:=strPath & "\" & Dir(strPath & "\" & strFile)
'   Read / Aggregate / Write data code here or in called sub
    Workbooks(strFile).Close SaveChanges:=False

    strFile = Dir
Loop

End Sub

Sub OpenFile(strPath, strFile)
Dim wbTarget, wbSource As Workbook

Set wbSource = Workbooks.Open(FileName:=strPath & "\" & Dir(strPath & "\" & strFile))
wbSource.Close SaveChanges:=False

End Sub

Answer 1

Dir(strPath & "\" & strFile)命令中的Workbooks.Open“覆盖”原始Dir - 您应该在此时使用strFile。

如果您将当前代码缩减到仅受Dir影响的位，它将如下所示：

strFile = Dir(some_string_including_wildcard)
'The above statement returns the first file name matching the wildcarded expression
Do While Len(strFile) > 0
    ... Dir(specific_filename_being_processed) ...
    'The above statement finds the first file name matching the specific filename
    'which will obviously be the specific filename

    strFile = Dir
    'That statement gets the next file name matching the argument last used as
    ' a parameter to a Dir.  As the last argument was a specific file, and there
    ' are no more files matching that argument (because it contained no wildcards)
    ' this returns an empty string.
Loop

您的代码应写为：

Sub LoopThroughFiles()

    Dim strName As String
    Dim strPath As String
    Dim strFile As String

    strPath = ThisWorkbook.Path
    strName = "Employee Gross Sales"
    strFile = Dir(strPath & "\" & strName & "*")

    Do While Len(strFile) > 0
        Debug.Print strFile
    '   OpenFile strPath, strFile  ' <-- Eventually will replace open / close commands below

        Workbooks.Open FileName:=strPath & "\" & strFile
    '   Read / Aggregate / Write data code here or in called sub
        Workbooks(strFile).Close SaveChanges:=False

        strFile = Dir
    Loop

End Sub

Sub OpenFile(strPath As String, strFile As String)
    Dim wbTarget As Workbook, wbSource As Workbook

    Set wbSource = Workbooks.Open(FileName:=strPath & "\" & strFile)
    wbSource.Close SaveChanges:=False

End Sub

在循环内添加打开和关闭命令时，Excel VBA目录循环失败

1 个答案: