Home > OS >  Batch replace multiple documents header, footer
Batch replace multiple documents header, footer

Time:09-26

Now I can replace the folder under multiple document text keywords, but cannot replace keyword to exist in the header, footer,

CodePudding user response:

Use of vba in word

CodePudding user response:

Sub jieyong ()
Application. ScreenUpdating=False 'close the screen flash
Dim arr () As String, i& K& X& , f, f1 $, oDoc As Document
Dim myFile $, myPath $, %, p myDoc As Object, myAPP As Object, TXT $, Re_txt $
BRR=Array (" confidential ", "aircraft carrier", "air carrier aircraft," aircraft carrier ", "the battlefield", "fight", "navy" and "aviation", "the ship", "carrier", "the ship", "ship to shore", "charge", "unit")
JM CRR=Array (" % % ", "% HM %", "% JZJ %", "% HKMJ %", "% ZC %", "% ZZ %", "% HJ %", "% HKB %", "% % what ZJ had", "% % MJ", "% % BJ", "% % JA", "% ZK %", "% %" BD)
The Set myAPP=New Word. Application
With the Application. The FileDialog (msoFileDialogFolderPicker)
If the Show=False Then Exit Sub
ReDim Preserve arr (1)
Arr. (1)=SelectedItems (1) & amp; ""
End With
I=1: k=1
The Do While I & lt; UBound (arr) + 1
If arr (I)="" Then Exit the Do
F=Dir (arr (I), vbDirectory), 'said the second parameter file attributes, here refers to a folder or directory
The Do While f & lt;> "
"If InStr (f, "")=0 And f & lt;> "" Then
K=k + 1
ReDim Preserve arr (k)
Arr (k)=arr (I) & amp; F & amp; ""
End the If
F=Dir
Loop
I=I + 1
Loop
For x=1 To UBound (arr)
If arr (x)="" Then Exit the For
F1=Dir (arr (x) & amp; * "" *. Docx)
The Do While f1 & lt;> "" 'file isn't empty
The Set oDoc=Documents. The Open (arr (x) & amp; F1, Visible:=False)
Whether the If oDoc. ProtectionType=wdNoProtection Then 'protected
For p=0 To 13
With oDoc. Content. The find
Text=BRR (p)
. Replacement. Text=CRR (p)
The Forward=True
Wrap=2
. The Format=False
The MatchCase=False
. MatchWholeWord=False
. MatchByte=True
. MatchWildcards=False
. MatchSoundsLike=False
. MatchAllWordForms=False
Execute the Replace:=2
Application. DisplayAlerts=wdAlertsNone
End With
Next
End the If
ODoc. Save
ODoc. Close
F1=Dir
Loop
Next x: Erase arr
MyAPP. Quit
Application. ScreenUpdating=True
MsgBox (" replace completely!" )
End Sub
  • Related