VBA to loop through sub folders and place Word template in each folder

JoeRooney

Board Regular
Joined
Nov 27, 2017
Messages
171
Office Version
  1. 365
Hi Guys,

I have been looking online but cant find anything matching my requirement and wanted to ask the question to see if it is possible. The requirement I have is I have a folder with 100's of individual sub folders, I need to place a blank word template that I have saved on the drive into each sub folder.

So I was thinking a loop is probably way to do this.

I am pretty sure this is possible but just not sure on how to go about it.

Any help is greatly appreciated.

I have some code that I have been using to select and move the folders to where I need them , I can attach if required.

Thanks
Joe
 

Excel Facts

Remove leading & trailing spaces
Save as CSV to remove all leading and trailing spaces. It is faster than using TRIM().
Use FileSystemObject to loop through the folders in the main folder and call the CopyFile method to copy the Word file.
 
Upvote 0
Thanks John ,

I have the below code that I used to move the folders I want to loop through and I think I can use this to use the copy file method and place them in the folder. But I am not sure where to apply the copy file method in the code , would you be able to assist me with this? Thanks for your help so far.

Thanks,



Sub Test1()
End Sub
Dim fDialog As FileDialog: Dim strTargetFolder As String: Dim strTestTracker As String: Dim wkbTestTracker As Workbook
Dim rgTestTrackerAccountNumbers As Range: Dim rg As Range: Dim strAccountNumber As String: Dim strMasterFolder As String
Dim fso As FileSystemObject: Dim mainFolder As Folder: Dim subFolder As Folder: Dim f As File
Dim strSourceFile As File

strSourceFile = "Z:\Test\Test.doc"
'Loop through the cells in the range to get the account number.
For Each rg In rgTestTrackerAccountNumbers.Cells
strAccountNumber = Trim(rg.Value)
'Loop through the subfolders and note the names. If the subfolder has the same name as the account, move that
'subfolder to the specified target folder.
For Each subFolder In mainFolder.SubFolders
If subFolder.Name = Trim(rg.Value) Then
'Move the subfolder to the specified path in (A)
fso.CopyFile , strSourceFile, subFolder.Path, strTargetFolder
Exit For
End If
Next subFolder
Next rg

exitSub:
'Clean-up the memory
Set wkbTestTracker = Nothing
Set fDialog = Nothing
Exit Sub

errorHandler:
MsgBox Err.Description
Resume exitSub
End Sub
 
Upvote 0
Try this, changing the 2 lines of code where indicated to suit.
Code:
Public Sub Copy_File_To_Subfolders()

    Dim FSO As Object 'Scripting.FileSystemObject
    Dim FSOfolder As Object 'Scripting.Folder
    Dim FSOsubfolder As Object 'Scripting.Folder
    Dim WordTemplate As String
    Dim mainFolder As String
    
    WordTemplate = "C:\path\to\template.docx" 'CHANGE THIS
    mainFolder = "C:\path\to\main folder" 'CHANGE THIS
    
    Set FSO = CreateObject("Scripting.FileSystemObject")
    
    If FSO.FileExists(WordTemplate) Then
        If FSO.FolderExists(mainFolder) Then
            Set FSOfolder = FSO.GetFolder(mainFolder)
            For Each FSOsubfolder In FSOfolder.SubFolders
                FSO.CopyFile WordTemplate, FSOsubfolder.Path & "\"
            Next
        Else
            MsgBox "Folder '" & mainFolder & "' doesn't exist"
        End If
    Else
        MsgBox "File to be copied '" & WordTemplate & "' doesn't exist"
    End If
    
End Sub
 
Upvote 0

Forum statistics

Threads
1,223,893
Messages
6,175,240
Members
452,621
Latest member
Laura_PinksBTHFT

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top