從子目錄中獲取excel文件中的數據

Question

我是VBA和編程的新手。這是我在這個板子上的第一篇文章。我一直在修改這個代碼，修改我在互聯網上找到的代碼，並且我有代碼來做我想做的事情，但是我想稍微修改它以加快此過程。

我的代碼從我的文件夾中存放我的桌面「接收溫度」，並在一個工作簿「接收數據提取」放在數據上Excel文件中提取數據。我每月從大約1000個文件中獲取數據，這些數據存儲在爲P.O命名的子目錄中。他們與（不同的名字）相關聯。現在，我必須通過這些子目錄中的每一個，並在宏工作之前將excel文件移動到「Receiving Temp」。我想修改代碼，對文件夾中的子目錄中包含的所有excel文件執行相同的操作，以便將子文件夾複製到「receive temp」文件夾中，然後運行宏而不是打開每個子目錄並抓取excel文件並手動移動它。再次，子目錄具有不同的名稱。

我很感激您可以提供的任何幫助。

Sub ReadDataFromAllWorkbooksInFolder() 
    Dim FolderName As String, wbName As String, r As Long 
    Dim cValue As Variant, bValue As Variant, aValue As Variant 
    Dim dValue As Variant, eValue As Variant, fValue As Variant 
    Dim wbList() As String, wbCount As Integer, i As Integer 

    FolderName = ThisWorkbook.Path & "\Receiving Temp\" 

    ' create list of workbooks in foldername 
    wbCount = 0 
    wbName = Dir(FolderName & "\" & "*.xls") 
    While wbName <> "" 
     wbCount = wbCount + 1 
     ReDim Preserve wbList(1 To wbCount) 
     wbList(wbCount) = wbName 
     wbName = Dir 
    Wend 
    If wbCount = 0 Then Exit Sub 
    ' get values from each workbook 
    r = 1 

    For i = 1 To wbCount 
     r = r + 1 
     cValue = GetInfoFromClosedFile(FolderName, wbList(i), "Quality Rep.", "c9") 
     bValue = GetInfoFromClosedFile(FolderName, wbList(i), "Quality Rep.", "o61") 
     aValue = GetInfoFromClosedFile(FolderName, wbList(i), "Quality Rep.", "ae11") 
     dValue = GetInfoFromClosedFile(FolderName, wbList(i), "Quality Rep.", "v9") 
     eValue = GetInfoFromClosedFile(FolderName, wbList(i), "Quality Rep.", "af3") 
     fValue = GetInfoFromClosedFile(FolderName, wbList(i), "Non Compliance", "a1") 


     Sheets("Sheet1").Cells(r, 1).Value = cValue 
     Sheets("Sheet1").Cells(r, 2).Value = bValue 
     Sheets("Sheet1").Cells(r, 3).Value = aValue 
     Sheets("Sheet1").Cells(r, 4).Value = dValue 
     Sheets("Sheet1").Cells(r, 6).Value = eValue 
     Sheets("Sheet1").Cells(r, 5).Value = fValue 
    Next i 
End Sub 

Private Function GetInfoFromClosedFile(ByVal wbPath As String, _ 
wbName As String, wsName As String, cellRef As String) As Variant 
    Dim arg As String 

    GetInfoFromClosedFile = "" 

    If Right(wbPath, 1) <> "\" Then wbPath = wbPath & "\" 

    If Dir(wbPath & "\" & wbName) = "" Then Exit Function 

    arg = "'" & wbPath & "[" & wbName & "]" & _ 
      wsName & "'!" & Range(cellRef).Address(True, True, xlR1C1) 

    On Error Resume Next 
    GetInfoFromClosedFile = ExecuteExcel4Macro(arg) 
End Function 

Answer 1

，你正在做的陣列的建立必須是從here採取ProcessFiles函數內。一旦數組產生，其餘的原始代碼幾乎保持原樣。我必須對GetInfoFromClosedFile函數進行更改，因此，當您複製時，請複製下面給出的完整代碼，並且不要更改任何內容。

Option Explicit 

Dim wbList() As String 
Dim wbCount As Long 

Sub ReadDataFromAllWorkbooksInFolder() 
    Dim FolderName As String 
    Dim cValue As Variant, bValue As Variant, aValue As Variant 
    Dim dValue As Variant, eValue As Variant, fValue As Variant 
    Dim i As Long, r As Long 

    FolderName = ThisWorkbook.Path & "\Receiving Temp" 

    ProcessFiles FolderName, "*.xls" 

    If wbCount = 0 Then Exit Sub 

    r = 1 

    For i = 1 To UBound(wbList) 

     '~~> wbList(i) will give you something like 
     ' C:\Receiving Temp\aaa.xls 
     ' C:\Receiving Temp\FOLDER1\aaa.xls 
     Debug.Print wbList(i) 

     r = r + 1 
     cValue = GetInfoFromClosedFile(wbList(i), "Quality Rep.", "c9") 
     bValue = GetInfoFromClosedFile(wbList(i), "Quality Rep.", "o61") 
     aValue = GetInfoFromClosedFile(wbList(i), "Quality Rep.", "ae11") 
     dValue = GetInfoFromClosedFile(wbList(i), "Quality Rep.", "v9") 
     eValue = GetInfoFromClosedFile(wbList(i), "Quality Rep.", "af3") 
     fValue = GetInfoFromClosedFile(wbList(i), "Non Compliance", "a1") 

     Sheets("Sheet1").Cells(r, 1).Value = cValue 
     Sheets("Sheet1").Cells(r, 2).Value = bValue 
     Sheets("Sheet1").Cells(r, 3).Value = aValue 
     Sheets("Sheet1").Cells(r, 4).Value = dValue 
     Sheets("Sheet1").Cells(r, 6).Value = eValue 
     Sheets("Sheet1").Cells(r, 5).Value = fValue 
    Next i 
End Sub 

'~~> This function was taken from 
'~~> http://www.vbaexpress.com/kb/getarticle.php?kb_id=245 
Sub ProcessFiles(strFolder As String, strFilePattern As String) 
    Dim strFileName As String, strFolders() As String 
    Dim i As Long, iFolderCount As Long 

    '~~> Collect child folders 
    strFileName = Dir$(strFolder & "\", vbDirectory) 
    Do Until strFileName = "" 
     If (GetAttr(strFolder & "\" & strFileName) And vbDirectory) = vbDirectory Then 
      If Left$(strFileName, 1) <> "." Then 
       ReDim Preserve strFolders(iFolderCount) 
       strFolders(iFolderCount) = strFolder & "\" & strFileName 
       iFolderCount = iFolderCount + 1 
      End If 
     End If 
     strFileName = Dir$() 
    Loop 

    '~~> process files in current folder 
    strFileName = Dir$(strFolder & "\" & strFilePattern) 
    Do Until strFileName = "" 
     wbCount = wbCount + 1 
     ReDim Preserve wbList(1 To wbCount) 
     wbList(wbCount) = strFolder & "\" & strFileName 
     strFileName = Dir$() 
    Loop 

    '~~> Look through child folders 
    For i = 0 To iFolderCount - 1 
     ProcessFiles strFolders(i), strFilePattern 
    Next i 
End Sub 

Private Function GetInfoFromClosedFile(ByVal wbFile As String, _ 
wsName As String, cellRef As String) As Variant 
    Dim arg As String, wbPath As String, wbName As String 

    GetInfoFromClosedFile = "" 

    wbName = FunctionGetFileName(wbFile) 
    wbPath = Replace(wbFile, "\" & wbName, "") 

    arg = "'" & wbPath & "\[" & wbName & "]" & _ 
      wsName & "'!" & Range(cellRef).Address(True, True, xlR1C1) 

    On Error Resume Next 
    GetInfoFromClosedFile = ExecuteExcel4Macro(arg) 
End Function 

'~~> Function to get file name from the full path 
'~~> Taken from http://www.ozgrid.com/VBA/GetExcelFileNameFromPath.htm 
Function FunctionGetFileName(FullPath As String) 
    Dim StrFind As String 
    Dim i As Long 

    Do Until Left(StrFind, 1) = "\" 
     i = i + 1 
     StrFind = Right(FullPath, i) 
     If i = Len(FullPath) Then Exit Do 
    Loop 
    FunctionGetFileName = Right(StrFind, Len(StrFind) - 1) 
End Function 

Answer 2

謝謝你們倆！一個簡單的Bing搜索讓我獲得了這個寶貴的代碼集合，我可以在幾分鐘內調整和應用這些代碼。優秀作品！

任何其他初學者（像我）想要使用此代碼，請注意以下幾點必要的修改：

ProcessFiles FolderName, "*.xls" 

應改爲「*的.xlsx」的excel2010文件。

在行：

cValue = GetInfoFromClosedFile(wbList(i), "Quality Rep.", "c9") 

和下面的類似線， 「質量代表」。應該更改爲要從中獲取數據的表單名稱。 在行：

Sheets("Sheet1").Cells(r, 1).Value = cValue 

和下面的「工作表Sheet1」應改爲你想要把數據表名稱。

除此之外，不需要更改。