Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
Dim objNamespace As Outlook.NameSpace
Dim objItem As Object
Dim objMail As Outlook.MailItem
Dim EntryID As String
Dim arrEntryIDs() As String
Dim i As Integer
' EntryIDCollectionを分割
arrEntryIDs = Split(EntryIDCollection, ",")
Set objNamespace = Application.GetNamespace("MAPI")
' 各メールに対して処理
For i = LBound(arrEntryIDs) To UBound(arrEntryIDs)
EntryID = arrEntryIDs(i)
Set objItem = objNamespace.GetItemFromID(EntryID)
' メールアイテムの場合
If TypeOf objItem Is Outlook.MailItem Then
Set objMail = objItem
' 指定の件名をチェック
If objMail.Subject = "指定した件名" Then
Dim replyMail As Outlook.MailItem
Dim bodyText As String
' 本文の文字列置換
bodyText = objMail.Body
bodyText = Replace(bodyText, "aaa", "xxx")
' 返信メール作成
Set replyMail = objMail.Reply
replyMail.Body = bodyText
replyMail.To = "返信先のメールアドレス@example.com" ' 指定アドレス
replyMail.Send
End If
End If
Next i
' 解放
Set objMail = Nothing
Set objItem = Nothing
Set objNamespace = Nothing
End Sub
Register as a new user and use Qiita more conveniently
- You get articles that match your needs
- You can efficiently read back useful information
- You can use dark theme