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

Author: Xiaoyang Last Modified: 2025-05-23

Outlookで、複数のメッセージ件名やタスク件名を指定したテキストに置き換える必要がある場合、もちろん1つずつ変更することはできますが、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", "Kutools for Excel") の中で、"kte" は検索したい古いテキストであり、"Kutools for Excel" は新しいテキストです。必要に応じてこれらを変更してください。

3. 「F5」キーを押してこのコードを実行すると、メッセージ件名内の特定のテキストが新しいテキストに置き換えられます。必要に応じた結果になります。スクリーンショットをご覧ください：

VBAコードを使用して複数のタスク内の件名テキストを検索して置換する

タスク内の件名テキストを検索して置換する必要がある場合、次のVBAコードも役立ちます。

1. 「ALT + F11」キーを押して「Microsoft Visual Basic for Applications」ウィンドウを開きます。

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」キーを押してこのコードを実行すると、プロンプトボックスが表示されますので、タスク件名から検索したいテキストを入力してください。スクリーンショットをご覧ください：