Обновление нескольких файлов Excel в том же месте

Question

Я видел аналогичный вопрос, где был приведен код ниже. Но я получаю сообщение об ошибке в строке «С». Я использую 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