Outlook でメッセージやタスク内の件名テキストを検索して置換するには、どうすればよいですか？

Outlook で複数のメールやタスクの件名を指定したテキストに一括置換したい場合、1 件ずつ手動で変更する以外に、一度に素早く処理する方法はあるでしょうか？

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．「OK」をクリックすると、もう1 つのプロンプトボックスが表示されるので、置き換えたい新しいテキストを入力してください（下図参照）。

5．次に「OK」をクリックすると、変更された件名の件数を示すダイアログボックスが表示されます（下図参照）。

6．「OK」をクリックすると、タスクの件名に含まれる古いテキストが新しいテキストに置き換わります（下図参照）。