vba outlook 検索返信

'ika code

Sub AutoReplyToEmail()
Dim OutlookApp As Object
Dim OutlookNamespace As Object
Dim Inbox As Object
Dim MailItem As Object
Dim ReplyMail As Object
Dim Item As Object
Dim subjectToFind As String
Dim found As Boolean

' 件名を指定
subjectToFind = "Your Email Subject Here" ' 検索するメールの件名に置き換えてください

' Outlookアプリケーションを起動
On Error Resume Next
Set OutlookApp = GetObject(, "Outlook.Application")
If OutlookApp Is Nothing Then
    Set OutlookApp = CreateObject("Outlook.Application")
End If
On Error GoTo 0

' Outlookの名前空間を取得
Set OutlookNamespace = OutlookApp.GetNamespace("MAPI")
Set Inbox = OutlookNamespace.GetDefaultFolder(6) ' 6 は受信トレイを示す定数

' 受信トレイのメールをループ
found = False
For Each Item In Inbox.Items
    If Item.Class = 43 Then ' 43 はMailItemを示す定数
        Set MailItem = Item
        If MailItem.Subject = subjectToFind Then
            found = True
            Exit For
        End If
    End If
Next Item

' 該当するメールが見つかった場合、返信
If found Then
    Set ReplyMail = MailItem.Reply
    With ReplyMail
        .Body = "This is an automatic reply." & vbCrLf & .Body ' 自動返信の本文に置き換えてください
        .Display ' メールを表示（送信は手動で行う）
    End With
    MsgBox "Reply created for the email with subject: " & subjectToFind
Else
    MsgBox "No email found with subject: " & subjectToFind
End If

' オブジェクトの解放
Set ReplyMail = Nothing
Set MailItem = Nothing
Set Inbox = Nothing
Set OutlookNamespace = Nothing
Set OutlookApp = Nothing

End Sub

コードの説明
件名の指定:

vba
コードをコピーする
subjectToFind = "Your Email Subject Here" ' 検索するメールの件名に置き換えてください
自動返信したいメールの件名を指定します。
Outlookアプリケーションの起動:

vba
コードをコピーする
Set OutlookApp = GetObject(, "Outlook.Application")
If OutlookApp Is Nothing Then
Set OutlookApp = CreateObject("Outlook.Application")
End If
Outlookアプリケーションを起動します。既に起動している場合はそのインスタンスを取得します。
受信トレイのメールをループ:

vba
コードをコピーする
For Each Item In Inbox.Items
If Item.Class = 43 Then ' 43 はMailItemを示す定数
Set MailItem = Item
If MailItem.Subject = subjectToFind Then
found = True
Exit For
End If
End If
Next Item
受信トレイ内のすべてのメールをループし、指定した件名のメールを探します。
メールが見つかった場合、返信を作成して表示:

vba
コードをコピーする
If found Then
Set ReplyMail = MailItem.Reply
With ReplyMail
.Body = "This is an automatic reply." & vbCrLf & .Body ' 自動返信の本文に置き換えてください
.Display ' メールを表示（送信は手動で行う）
End With
MsgBox "Reply created for the email with subject: " & subjectToFind
Else
MsgBox "No email found with subject: " & subjectToFind
End If
該当するメールが見つかった場合、そのメールに返信を作成し、Outlookの送信ダイアログを表示します。送信は手動で行います。
使用手順
Excelファイルを開き、Alt + F11を押してVBAエディターを開きます。
メニューから "Insert" > "Module" を選択し、新しいモジュールを挿入します。
上記のコードをコピーして、挿入したモジュールに貼り付けます。
subjectToFindを自動返信したいメールの件名に置き換えます。
VBAエディターを閉じて、Excelに戻ります。
Alt + F8を押して "Macro" ダイアログを開き、"AutoReplyToEmail" を選択して "Run" をクリックします。
これで、指定された件名のメールに対して返信メールが作成され、Outlookの送信ダイアログが表示されます。送信は手動で行うことができます。