excelマクロをフォルダ内のすべてのディレクトリで再帰的に実行する

Question

私は多くのサブフォルダを持っているフォルダを持っており、その中に1000を超えるExcelファイルがあります。 wb）すべての1000のファイルとサブフォルダに？ は既に問題（VBA上）である を次のように回答していますが、その回答には2つの問題があります。 1.このソリューションは非常に遅くなります。おそらく... 2.このマクロは、一致するフォルダのファイルでのみ実行され、すべてのサブフォルダ内のファイルには実行されません。 サブフォルダ内のファイルに対しても同様の方法がありますか？

VBA：

Sub ProcessFiles() 
    Dim Filename, Pathname As String 
    Dim wb As Workbook 

    Pathname = ActiveWorkbook.Path & "\C:\...\EXCL\" 
    Filename = Dir(Pathname & "*.xlsx") 
    Do While Filename <> "" 
     Set wb = Workbooks.Open(Pathname & Filename) 
     DoWork wb 
     wb.Close SaveChanges:=True 
     Filename = Dir() 
    Loop 
End Sub 

Sub DoWork(wb As Workbook) 
    With wb 
     'Do your work here 
     ...... 
    End With 
End Sub 

Answer 1

私の知る限りでは、VBAはクローゼットブックを編集することはできません。すべてのサブフォルダ、サブフォルダのサブフォルダなどのすべてのワークブックで作業を行いたい場合は、次のコードを使用できます。私は条件を追加しました。それは.xlsxファイルでなければなりません。.xls、.xlsbまたはあなたが望むものでそれを変更することができます。

Answer 2

この権利がある場合は、ディレクトリとサブディレクトリ内のすべてのxlファイルを収集する機能が必要です。この関数は、それを行います。

Public Function RecursiveDir(colFiles As Collection, _ 
          strFolder As String, _ 
          strFileSpec As String, _ 
          bIncludeSubfolders As Boolean) 

    Dim strTemp As String 
    Dim colFolders As New Collection 
    Dim vFolderName As Variant 

    'Add files in strFolder matching strFileSpec to colFiles 
    strFolder = TrailingSlash(strFolder) 
    strTemp = Dir(strFolder & strFileSpec) 
    Do While strTemp <> vbNullString 
     colFiles.Add strFolder & strTemp 
     strTemp = Dir 
    Loop 

    If bIncludeSubfolders Then 
     'Fill colFolders with list of subdirectories of strFolder 
     strTemp = Dir(strFolder, vbDirectory) 
     Do While strTemp <> vbNullString 
      If (strTemp <> ".") And (strTemp <> "..") Then 
       If (GetAttr(strFolder & strTemp) And vbDirectory) <> 0 Then 
        colFolders.Add strTemp 
       End If 
      End If 
      strTemp = Dir 
     Loop 

     'Call RecursiveDir for each subfolder in colFolders 
     For Each vFolderName In colFolders 
      Call RecursiveDir(colFiles, strFolder & vFolderName, strFileSpec, True) 
     Next vFolderName 
    End If 

End Function 


Public Function TrailingSlash(strFolder As String) As String 
    If Len(strFolder) > 0 Then 
     If Right(strFolder, 1) = "\" Then 
      TrailingSlash = strFolder 
     Else 
      TrailingSlash = strFolder & "\" 
     End If 
    End If 
End Function 

そして、これは

Sub TesterFiles() 

Dim colFiles As New Collection 

    RecursiveDir colFiles, "Your Dir goes here...", "*.XLS*", True 

    Dim vFile As Variant 
    For Each vFile In colFiles 
     ' Do sth with the file 
     Debug.Print vFile 
    Next vFile 

End Sub 

Answer 3

素敵な1 Storaxをそれを使用する方法を示しています！私はStoraxが投稿したスクリプトを使用し、ちょっとした変更をします。

i = 1 
Dim vFile As Variant 
For Each vFile In colFiles 
    ' Do sth with the file 
    Range("A" & i).Value = vFile 
    i = i + 1 
Next vFile 

リストを使うほうが簡単だと思います。とにかく、ファイル構造を取得したら、作成した配列の要素を実行することができます。それを行うには、以下のスクリプトを使用してください。

Sub LoopThroughRange() 

Dim rng As Range, cell As Range 
Set rng = Range("A1:A13") 

For Each cell In rng 

     'For Fnum = LBound(MyFiles) To UBound(MyFiles) 
      Set mybook = Nothing 
      On Error Resume Next 
      Set mybook = Workbooks.Open(cell) 
      On Error GoTo 0 

      If Not mybook Is Nothing Then 


       'Change cell value(s) in one worksheet in mybook 
       On Error Resume Next 
       With mybook.Worksheets(1) 
        If .ProtectContents = False Then 
         .Range("A1").Value = "My New Header" 
        Else 
         ErrorYes = True 
        End If 
       End With 


       If Err.Number > 0 Then 
        ErrorYes = True 
        Err.Clear 
        'Close mybook without saving 
        mybook.Close savechanges:=False 
       Else 
        'Save and close mybook 
        mybook.Close savechanges:=True 
       End If 
       On Error GoTo 0 
      Else 
       'Not possible to open the workbook 
       ErrorYes = True 
      End If 

     'Next Fnum 

Next cell 

End Sub 

アイデアはここからまっすぐです。この部分に

http://www.rondebruin.nl/win/s3/win010.htm

ご注意：あなたは正確にあなたがやりたいために特定のコードを入れたいところだのMyBook で1つのワークシートで 「変更セル値（秒）。

私はOPを変更しました。私が最初に作り出したものよりずっと簡単で、少し違っています。私はそれに応じてスクリプトを調整しました。