現在我已經可以替換檔案夾下的多個檔案正文的關鍵字，但是無法替換存在于頁眉頁腳的關鍵字。
uj5u.com熱心網友回復：
用的word 里面的 vbauj5u.com熱心網友回復：
Sub jieyong()Application.ScreenUpdating = False '關閉螢屏閃
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("機密", "航母", "航載機", "航空母艦", "戰場", "作戰", "海軍", "航空兵", "著艦", "母艦", "本艦", "艦岸", "指控", "編隊")
crr = Array("%JM%", "%HM%", "%JZJ%", "%HKMJ%", "%ZC%", "%ZZ%", "%HJ%", "%HKB%", "%ZJ%", "%MJ%", "%BJ%", "%JA%", "%ZK%", "%BD%")
Set myAPP = New Word.Application
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show = False Then Exit Sub
ReDim Preserve arr(1)
arr(1) = .SelectedItems(1) & "\"
End With
i = 1: k = 1
Do While i < UBound(arr) + 1
If arr(i) = "" Then Exit Do
f = Dir(arr(i), vbDirectory) '第二個引數表示檔案屬性，在這里指的是檔案夾或目錄
Do While f <> ""
If InStr(f, ".") = 0 And f <> "" Then
k = k + 1
ReDim Preserve arr(k)
arr(k) = arr(i) & f & "\"
End If
f = Dir
Loop
i = i + 1
Loop
For x = 1 To UBound(arr)
If arr(x) = "" Then Exit For
f1 = Dir(arr(x) & "*.docx*")
Do While f1 <> "" '檔案不為空
Set oDoc = Documents.Open(arr(x) & f1, Visible:=False)
If oDoc.ProtectionType = wdNoProtection Then '是否受保護
For p = 0 To 13
With oDoc.Content.find
.Text = brr(p)
.Replacement.Text = crr(p)
.Forward = True
.Wrap = 2
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute Replace:=2
Application.DisplayAlerts = wdAlertsNone
End With
Next
End If
oDoc.Save
oDoc.Close
f1 = Dir
Loop
Next x: Erase arr
myAPP.Quit
Application.ScreenUpdating = True
MsgBox ("全部替換完畢！")
End Sub
轉載請註明出處，本文鏈接：https://www.uj5u.com/caozuo/79833.html