如何在 Outlook 中查找並替換郵件或任務主旨中的文字？

在 Outlook 中，若有大量郵件主旨或任務標題需要替換為您指定的文字，當然可以逐一修改，但您是否希望有更快速的方式一次完成這項工作？

使用 VBA 程式碼查找和替換多封郵件中的主旨文字

使用 VBA 程式碼查找和替換多個任務中的主旨文字

---

使用 VBA 程式碼查找和替換多封郵件中的主旨文字

若要在多封郵件主旨中尋找特定文字並替換為其他文字，以下 VBA 程式碼可協助您達成，請依照下列步驟操作：

1. 選取您要查找並替換主旨文字的電子郵件，然後按住「Alt + F11」鍵，開啟「Microsoft Visual Basic for Applications」視窗。

2. 接著點選「插入」>「模組」，將下方程式碼複製並貼上至開啟的空白模組中，如下圖所示：

VBA 程式碼：查找和替換多封郵件中的主旨文字：

Option Explicit
Sub FindAndReplaceInSubject()
Dim xItem As Object
Dim xNewSubject As String
Dim xMailItem As MailItem
Dim xExplorer As Explorer
Dim i As Integer
On Error Resume Next
Set xExplorer = Outlook.Application.ActiveExplorer
For i = xExplorer.Selection.Count To 1 Step -1
    Set xItem = xExplorer.Selection.Item(i)
    If xItem.Class = olMail Then
        Set xMailItem = xItem
        With xMailItem
            xNewSubject = Replace(.Subject, "kte", "Kutools for Excel")
            .Subject = xNewSubject
            .Save
        End With
    End If
Next
End Sub

注意：在上述程式碼中，`xNewSubject = Replace（。Subject， "kte“， “【【PH_1】】“）`，「kte」是您要搜尋的舊文字，而「Kutools for Excel」則是要用來取代的新文字。請根據實際需求調整這些內容。

3. 接著按下「F5」鍵執行此程式碼，郵件主旨中的特定文字便會依您的需求替換為新文本，如下圖所示：

---

使用 VBA 程式碼查找和替換多個任務中的主旨文字

若您需要在查找與取代任務中處理主旨文字，以下 VBA 程式碼也能協助您。

1. 按住「Alt + F11」鍵，即可開啟「Microsoft Visual Basic for Applications」視窗。

2. 接著點選「插入」>「模組」，將下方程式碼複製並貼上至開啟的空白模組中，如下圖所示：

VBA 程式碼：查找和替換所有任務中的主旨文字：

Option Explicit
Sub FindReplaceTextsInAllTaskSubjects()
Dim xPane As NavigationPane
Dim xModule As TasksModule
Dim xGroup As NavigationGroup
Dim xNavFolder As NavigationFolder
Dim xTaskItem As Outlook.TaskItem
Dim i, k As Integer
Dim xFindStr, xReplaceStr As String
Dim xTotalCount As Long
On Error Resume Next
xFindStr = InputBox("Type the words to find:", "Kutools for Outlook", xFindStr)
If Len(Trim(xFindStr)) = 0 Then Exit Sub
xReplaceStr = InputBox("Type the words to replace:", "Kutools for Outlook", xReplaceStr)
If Len(Trim(xReplaceStr)) = 0 Then Exit Sub
xTotalCount = 0
Set xPane = Outlook.Application.ActiveExplorer.NavigationPane
Set xModule = xPane.Modules.GetNavigationModule(olModuleTasks)
Set xGroup = xModule.NavigationGroups.Item(1)
For i = xGroup.NavigationFolders.Count To 1 Step -1
    Set xNavFolder = xGroup.NavigationFolders.Item(i)
    For k = xNavFolder.Folder.Items.Count To 1 Step -1
        Set xTaskItem = xNavFolder.Folder.Items(k)
        If InStr(xTaskItem.Subject, xFindStr) > 0 Then
            xTaskItem.Subject = Replace(xTaskItem.Subject, xFindStr, xReplaceStr)
            xTaskItem.Save
            xTotalCount = xTotalCount + 1
        End If
    Next
Next
MsgBox xTotalCount & " task subjects have been changed!", vbInformation + vbOKOnly, "Kutools for Outlook"
End Sub

3. 接著按下「F5」鍵執行此程式碼，此時會彈出一個提示方塊，請輸入您要從任務主旨中搜尋的文字，如下圖所示：

4. 點選「確定」後，會再彈出另一個提示方塊，請輸入您要用來取代的新文本，如下圖所示：

5. 接著點選「確定」，系統會顯示一個對話方塊，告知您已變更多少個主旨，如下圖所示：

6. 點選「確定」後，任務主旨中的舊文本便會被新文字取代，如下圖所示：