#1
|
|||
|
|||
Batch change the footer in multiple files with footer from another file
Hi to all.
I have many many word files inside a folder and subfolders and i would like to change their footer. I would like to change/replace the footer to all these files with the footer i use in a specific word file (let's say this specific word file is my guide). So I was wondering if there is a macro to choose the folder i want and then change the footer in all word documents at once (in that folder and it's subfolders). i know how to use custom process from Document Batch Processes, so if there is a macro for Document Batch Processes it would be great. Thanks in advance for your time and help. |
#2
|
||||
|
||||
Try running the following macro from the document containing the footer you want to replicate:
Code:
Option Explicit Dim FSO As Object, oFolder As Object, StrFldrs As String Dim DocSrc As Document, DocTgt As Document, Rng As Range Dim StrPth As String, StrNm As String, StrSrc As String Sub Main() Application.ScreenUpdating = False Dim TopLevelFolder As String, TheFolders As Variant, aFolder As Variant, i As Long TopLevelFolder = GetFolder: If TopLevelFolder = "" Then Exit Sub Set DocSrc = ActiveDocument: StrSrc = DocSrc.FullName Set Rng = DocSrc.Sections.First.Footers(wdHeaderFooterPrimary).Range StrFldrs = vbCr & TopLevelFolder If FSO Is Nothing Then Set FSO = CreateObject("Scripting.FileSystemObject") End If 'Get the sub-folder structure Set TheFolders = FSO.GetFolder(TopLevelFolder).SubFolders For Each aFolder In TheFolders RecurseWriteFolderName (aFolder) Next 'Process the documents in each folder For i = 1 To UBound(Split(StrFldrs, vbCr)) Call UpdateDocuments(CStr(Split(StrFldrs, vbCr)(i))) Next Set Rng = Nothing: Set DocTgt = Nothing: Set DocSrc = Nothing Set TheFolders = Nothing: Set FSO = Nothing Application.ScreenUpdating = True End Sub Sub UpdateDocuments(StrPth As String) StrNm = Dir(StrPth & "\*.doc", vbNormal) While StrNm <> "" If StrPth & "\" & StrNm <> StrSrc Then Set DocTgt = Documents.Open(FileName:=StrPth & "\" & StrNm, AddToRecentFiles:=False, Visible:=False) With DocTgt With .Sections.First.Footers(wdHeaderFooterPrimary).Range .FormattedText = Rng.FormattedText .Characters.Last.Text = vbNullString End With .Close True End With End If StrNm = Dir() Wend End Sub Function GetFolder() As String Dim oFolder As Object GetFolder = "" Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Choose a folder", 0) If (Not oFolder Is Nothing) Then GetFolder = oFolder.Items.Item.Path Set oFolder = Nothing End Function Sub RecurseWriteFolderName(aFolder) Dim SubFolders As Variant, SubFolder As Variant Set SubFolders = FSO.GetFolder(aFolder).SubFolders StrFldrs = StrFldrs & vbCr & CStr(aFolder) On Error Resume Next For Each SubFolder In SubFolders RecurseWriteFolderName (SubFolder) Next End Sub
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#3
|
|||
|
|||
Unfortunately it doesn't work, I get compile error: variable not defined.
I have only docx files, so i changed the line StrNm = Dir(StrPth & "\*.doc", vbNormal) to StrNm = Dir(StrPth & "\*.docx", vbNormal) but again i get the same error. P.S. I don't know if it's important to mention, but the footer i want to copy to all other files, contains text, a table (one row) and an image. |
#4
|
||||
|
||||
I can't see how that could be possible if you're using the variables as defined in the posted code - StrNm & StrPth are quite clearly defined.
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#5
|
|||
|
|||
Quote:
1) Opened the word file that contains the footer i want. 2) Pressed Alt+F11, and choose the file from left panel. 3) From "Insert UseForm" icon, i choose module. 4) I paste the code you wrote here. 5) I pressed F5. 6) Opened a popup window to choose the folder i want and i choose it. 7) After pressing OK button from popup window i get the error i told you. |
#6
|
|||
|
|||
Ok an update...
I put the file that has the footer i need outside the folder i want the word files to be changed (i put it in my desktop because it was inside the folder i wanted to work with). I run the macro again and now i get another error: Run-time error '91: Object variable or With block variable not set. When i press debug i got the following line with yellow background: With .Sections.First.Footers(wdHeaderFooterPrimary).Ran ge |
#7
|
||||
|
||||
The code must be run against an active document containing the relevant footer. If you're getting an error message on that line, that suggests the active document lacks the relevant footer.
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#8
|
|||
|
|||
Ok here is the file that contains the footer i want to take and to replace to all other word files.
When i run the macro this file is active. |
#9
|
||||
|
||||
I have run the code with your document as the active document and do not get that error. I suggest you re-copy the code and paste into your attachment's 'ThisDocument' code module - and ensure your attachment is the active document when you run the code. You might then even change:
Set DocSrc = ActiveDocument to: Set DocSrc = ThisDocument so that your attachment does not need to be the active document when you run the code.
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#10
|
|||
|
|||
Quote:
Thanks a lot for your help and patience. |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
Batch replace Header and Footer and QuickStyle | Artmax | Word VBA | 14 | 01-11-2024 05:36 PM |
Batch change the font style in multiple word files inside folder and subfolders | kalagas | Word VBA | 11 | 10-05-2023 05:13 AM |
Batch applying a macro to remove Header and Footer using Batch Auto Addin | Edszx | Word VBA | 2 | 05-27-2019 11:16 PM |
I have 20 page word document with a footer. Can i change page # 10 footer only? | aligahk06 | Word | 2 | 10-25-2017 04:53 AM |
Word Macro - change date in footer for all files in a folder | patidallas22 | Word VBA | 2 | 03-09-2012 08:14 AM |