更新同一位置的多个Excel文件

Question

我看到了类似的问题，其中提供了以下代码。但我在“With”行上收到错误。我正在使用excel 2010.请帮助。

Sub Auto_open_change()

Dim WrkBook As Workbook
Dim StrFileName As String
Dim FileLocnStr As String
Dim LAARNmeWrkbk As String

PERNmeWrkbk = ThisWorkbook.Name
StrFileName = "*.xlsx"
FileLocnStr = ThisWorkbook.Path
Workbooks.Open (FileLocnStr & "\" & StrFileName)
Workbooks(StrFileName).Activate

With Application.FindFile
SearchSubFolders = False
LookIn = "Network location"
Filename = "*.xlsm"
If .Execute > 0 Then
    Debug.Print "There were " & .FoundFiles.Count & " file(s) found."
    For i = 1 To .FoundFiles.Count
        ' added Set as per web cite, original did not have it
        Set WrkBook = Workbooks.Open(Filename:=.FoundFiles(i))
        WrkBook.Worksheets(1).Select
        ThisWorkbook.Worksheets(1).Cells(DestinationRange) = WrkBook.Worksheets(1).Cells(SourceRange).Value
    Next i
Else
    Debug.Print "There were no files found."

End If

错误说明：

Compile Error
With object must be user-defined type, Object, or Variant 

Answer 1

要打开工作簿的代码不起作用，因为该文件没有有效名称。我会推荐你​​this以获得进一步的指导。

对于FindFile（），请尝试：

With Application.FileSearch
    .SearchSubFolders = False
    .LookIn = "Network location"
    .Filename = "*.xlsm"

    If .Execute > 0 Then
        Debug.Print "There were " & .FoundFiles.Count & " file(s) found."
        For i = 1 To .FoundFiles.Count
            ' added Set as per web cite, original did not have it
            Set WrkBook = Workbooks.Open(Filename:=.FoundFiles(i))
            WrkBook.Worksheets(1).Select
            ThisWorkbook.Worksheets(1).Cells(DestinationRange) = WrkBook.Worksheets(1).Cells(SourceRange).Value
        Next i
    Else
        Debug.Print "There were no files found."

    End If
End With

Answer 2

我建议转而使用DIR代替。您对Application.FindFile的实施以及您对With的使用似乎都是错误的。

取而代之的是：

Sub test()
    Dim WrkBook As Workbook
    Dim strPath As String, strFile As String

    'Path to search for files
    strPath = "C:\"

    'Store the first found file that matches "*.txt" in strFile
    strFile = Dir(strPath + "*.xlsm")

    'Loop through files
    Do While strFile <> ""

        'Do your stuff here
        Set WrkBook = Workbooks.Open(strPath & "/" & strFile)
        WrkBook.Worksheets(1).Select

        'Doesn't look like DestinationRange or SourceRange are set up here yet
        ThisWorkbook.Worksheets(1).Cells(DestinationRange) = WrkBook.Worksheets(1).Cells(SourceRange).Value

        'Close the found workbook
        WrkBook.Close False
        'set strFile to the next matching file in the path
        strFile = Dir
    Loop


End Sub