VB宏Excel腳本應複製整個文件夾數據

Question

背景：約。 300 Excel調查（多張）應該集中在一個單獨的Excel中。宏已準備就緒。 目標：雖然宏已經準備好並且能夠從Survey Excel複製所需數據，但我沒有可能立即複製所有300個調查（我必須通過所有調查一一進行）

問題：是否有可能要求宏從特定的網絡路徑中複製目標文件，並據此複製所有300個Excel工作簿？

宏腳本：

Function bIsBookOpen(ByRef szBookName As String) As Boolean 
    On Error Resume Next 
    bIsBookOpen = Not (Application.Workbooks(szBookName) Is Nothing) 
End Function 

Sub Start() 
currwb = ActiveWorkbook.Name 

If bIsBookOpen("PERSONAL.XLSB") Then 
    Windows("PERSONAL.XLSB").Visible = True 
    ActiveWindow.Close 
End If 

If Workbooks.Count > 1 Then 
MsgBox " To many files open... " & Workbooks(1).Name 
Else 
Application.Dialogs(xlDialogOpen).Show 
Response = MsgBox("Weiter mit 'IT-Personal'?", vbYesNo) 
If Response = vbYes Then 
Windows(currwb).Activate 
Call CopyForm 
End If 

End If 

End Sub 

Answer 1

要遍歷文件夾中的文件，

Sub LoopThroughFiles() 
    Dim path As String 
    Dim filename As String 
    Dim wb As Workbook 
    path = "" 'your folder path here 
    filename = Dir(path & "*.xls") 

    While (filename <> "") 
     Set wb = Workbooks.Open(path & filename) 
     'Your code goes here 
     wb.Close 
     filename = Dir 
    Wend 
End Sub