VBA Macro to loop through folder and sub folder to check .dxf file

[subhashmecha]

Hi,

   I need help with VBA Macro. I made program to replace title block from the template(.dxf)file to the files(.dxf) in given folder. I can able to replaces the title block in files(.dxf) in given folder but not in the subfolder. 

How to read files to subfolders in given folder. I have attached my Macro with this post.

Thank you in Advance. 

[norman.yuan]

Firstly, there is no need to use Windows Scripting component in your VBA code. You should use VBA built-in function Dir() to loop through files/folders. Using extra component that is not VBA built-in, you added unnecessary dependency to your code, and Windows Scripting component may not be enabled if the computer is in a tightly regulated corporate network.

Since you need to go through all subfolders of a given folder, you need to RECURSIVELY call Dir() to find all subfolders underneath. If you google DIR() and "recursive" you would get a lots of links.  

Here I put together some quick code to demonstrate how to dig how subfolders recursively and return a string array with full path of all subfolders. Once you get all the full paths of all subfolders, you can then loop through the subfolder path array to search files in each folder:

Option Explicit

Public Sub Test()

    Dim root As String
    root = "c:\Temp\TestFolder"
    
    Dim paths() As String
    ReDim paths(0)
    paths(0) = root
    
    ''Find all subnfolders' full paths and saved in an array of string
    GetFolders root, paths
    
    ''Show all subfolders' path
    Dim folder As Variant
    For Each folder In paths
        Debug.Print folder
    Next

End Sub

Private Sub GetFolders(rootFolder As String, paths As Variant)

    Dim i As Integer
    Dim folder As String
    Dim folders As Collection
    Set folders = New Collection
    
    Dim root As String
    root = rootFolder & "\"
    folder = Dir(root, vbDirectory)
    Do While (folder <> "")
    
        If folder <> "." And folder <> ".." Then
            If (GetAttr(root & folder) And vbDirectory) = vbDirectory Then
                i = UBound(paths) + 1
                ReDim Preserve paths(i)
                paths(i) = root & folder
                folders.Add root & folder
            End If
        End If
        
        folder = Dir
    
    Loop
    
    Dim fd As Variant
    If folders.Count > 0 Then
        For Each fd In folders
            ''Call the function itself recursively
            GetFolders CStr(fd), paths
        Next
    End If

End Sub

HTH