Outlookのカレンダーで予定の件名を検索して置換するにはどうすればよいですか？

Author: Siluvia Last Modified: 2025-05-23

Outlookカレンダーで予定の件名を検索して置き換えることは、複数の件名を同じテキストに置き換えたい場合や、Outlookでのデータインポート後に件名フィールドの「コピー」という単語を置き換えたい場合に役立ちます。この記事では、複数の予定の件名を検索して置換するためのVBAコードを提供します。詳細は以下をご覧ください。

VBAコードを使用して予定の件名を検索および置換する

VBAコードを使用して予定の件名を検索および置換する

このセクションでは、次の手順に従ってVBAコードを使用して予定の件名を検索および置換できます。

1. まず、Outlookでマクロ設定を低く設定する必要があります。

1) Outlook 2010および2013では、「ファイル」>「オプション」をクリックします。「Outlookオプション」ダイアログボックスで、左側のバーにある「トラストセンター」をクリックし、「トラストセンターの設定」ボタンをクリックします。

「トラストセンター」ダイアログボックスで、左側のバーにある「マクロの設定」をクリックし、「すべてのマクロを有効にする」オプションを選択します。そして、「OK」ボタンをクリックします。スクリーンショットをご覧ください：

2) Outlook 2007では、「ツール」>「トラストセンター」をクリックしてください。「トラストセンター」ダイアログボックスで、左側のバーにある「マクロの設定」をクリックし、「マクロのセキュリティチェックなし」オプションを選択して「OK」ボタンをクリックします。

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

3. 「Microsoft Visual Basic for Applications」ウィンドウで、「project1」>「Microsoft Outlook Objects」>「ThisOutlookSession」をダブルクリックして展開し、VBAエディターを開きます。スクリーンショットをご覧ください：

4. 次のVBAコードをコピーしてVBAエディターに貼り付けます。そして、「F5」キーを押してコードを実行します。

VBA: 予定の件名を検索して置換

Sub FindReplaceAppointment()
    Dim oApp As Outlook.Application
    Dim oCalFolder As Outlook.MAPIFolder
    Dim oAppt As Outlook.AppointmentItem
    Dim sOldText As String
    Dim sNewText As String
    Dim iCalChangedCount As Integer
    Set oApp = Outlook.Application
    MsgBox ("This script will perform a find/replace in the subject line of all appointments in a specified calendar.")
    sOldText = InputBox("What is the text string that you would like to replace?")
    sNewText = InputBox("With what would you like to replace it?")
    ' Check to be sure a Calendar folder was selected
    Do
    If Not (oCalFolder Is Nothing) Then
        If (oCalFolder.DefaultItemType = olAppointmentItem) Then Exit Do
    End If
    MsgBox ("Please select a calendar folder from the following list.")
    Set oCalFolder = Application.Session.PickFolder
    On Error GoTo ErrHandler:
    Loop Until oCalFolder.DefaultItemType = olAppointmentItem
    ' Loop through appointments in calendar, change text where necessary, keep count
    iCalChangedCount = 0
    For Each oAppt In oCalFolder.Items
        If InStr(oAppt.Subject, sOldText) <> 0 Then
            Debug.Print "Changed: " & oAppt.Subject & " - " & oAppt.Start
            oAppt.Subject = Replace(oAppt.Subject, sOldText, sNewText)
            oAppt.Save
            iCalChangedCount = iCalChangedCount + 1
        End If
    Next
    ' Display results and clear table
    MsgBox (iCalChangedCount & " appointments had text in their subjects changed from '" & sOldText & "' to '" & sNewText & "'.")
    Set oAppt = Nothing
    Set oCalFolder = Nothing
Exit Sub
ErrHandler:
    MsgBox ("Macro terminated.")
End Sub

5. コードを実行すると、「Microsoft Outlook」ダイアログボックスが表示されます。「OK」ボタンをクリックします。