最近在工作中遇到某一資料夾下的許多檔案，名字和內容有大量需要替換，一個個手工替換很麻煩，於是修改了一段程式碼：

Sub 批量更改word要素編號及檔名() '此程式碼為指定資料夾中所有選取的WORD檔案的進行格式設定
Dim MyDialog As FileDialog, vrtSelectedItem As Variant, Doc As Document
Dim NewName As String, thisPath As String
' On Error Resume Next '忽略錯誤
'定義一個資料夾選取對話方塊
Set MyDialog = Application.FileDialog(msoFileDialogFilePicker)
With MyDialog
    .Filters.Clear '清除所有檔案篩選器中的專案
    .Filters.Add "所有 WORD 檔案", "*.doc", 1 '增加篩選器的專案為所有WORD檔案
    .AllowMultiSelect = True '允許多項選擇
    If .Show = -1 Then '確定
        myPas = InputBox("請輸入替換成的編號：")
        Application.ScreenUpdating = False
      
        For Each vrtSelectedItem In .SelectedItems '在所有選取專案中迴圈
          Set Doc = Documents.Open(FileName:=vrtSelectedItem, Visible:=False)
         'Doc.Name = Replace(Doc.Name, "流程編號+", myPas)
        Doc.ActiveWindow.Selection.Find.Execute "流程編號+", , , , , , , , , myPas, wdReplaceAll
        ' Doc.SaveAs FileName:=Replace(vrtSelectedItem, "流程編號+", myPas)
 
        Doc.Close True
        
        '修改檔名
                NewName = Replace(vrtSelectedItem, "流程編號+", myPas&" ")
                If NewName <> "" Then
                    Name vrtSelectedItem As NewName
                End If
         Next
        Application.ScreenUpdating = True

    End If
End With
Set Doc = Nothing  '釋放變數
MsgBox "編號更改完畢，請檢查", vbInformation
End Sub