Reply All to Specific Email

[dabrows]

I found the link below and the first code section works...it finds the email I need. I want to add to the code by 'Replying All' and adding the current workbook as an attachment.

I have tried to define the OutMail as an Outlook.MailItem so that I can access the properties of OutMail but when make that change and run it, I get a runtime error 13 Type Mismatch. Any suggestions?




Sub TestMailTool() ' Is working in Office 2000-2007
' based on www.vbaexpress.com/forum/showthread.php?63392-search-and-send-email-from-outlook-using-macro-from-excel

Dim OutApp As Object
Dim OutNameSpace As Object
Dim OutFolder As Object
Dim OutItms As Object
Dim OutMail As Outlook.MailItem
Dim i As Integer
Dim mail
Dim replyall As Object
'Dim strbody As String
'Dim MyTasks As Object
'Dim sir() As String
'Dim myitems As Outlook.Items
'Dim myitem As Object


Set OutApp = CreateObject("Outlook.Application")
'Set OutMail = OutApp.CreateItem(0)
Set OutNameSpace = OutApp.GetNamespace("MAPI")
Set OutFolder = OutNameSpace.GetDefaultFolder(6)
Set OutItms = OutFolder.Items
i = 1
'Set MyTasks = OutFolder.Items
'Set myitems = myInbox.Items


For Each OutMail In OutFolder.Items
If InStr(OutMail.Subject, "Hello 12345") <> 0 Then

OutMail.Display
OutMail.replyall
Body = "test reply" & vbCrLf & BR
i = i + 1
End If
Next OutMail
End Sub

[dabrows]

The code below worked for me - thank you ChatGPT!


Sub ReplyToEmails() Dim olApp As Object
Dim olNamespace As Object
Dim olFolder As Object
Dim olMail As Object
Dim olReply As Object
Dim olRecipients As Object
Dim i As Integer
Dim subjectToSearch As String

' Set the subject to search for
subjectToSearch = "Test Email"

' Create Outlook application and get the inbox folder
Set olApp = CreateObject("Outlook.Application")
Set olNamespace = olApp.GetNamespace("MAPI")
Set olFolder = olNamespace.GetDefaultFolder(6) ' 6 represents the Inbox folder

' Loop through each email in the inbox
For Each olMail In olFolder.Items
' Check if the email subject matches the search string
If InStr(olMail.Subject, subjectToSearch) > 0 Then
' Open the email and display the reply all window
Set olReply = olMail.replyall
olReply.Display
' Attach the current workbook to the reply email
olReply.Attachments.Add ThisWorkbook.FullName
' Clean up objects
Set olReply = Nothing
End If
Next olMail

' Clean up objects
Set olFolder = Nothing
Set olNamespace = Nothing
Set olApp = Nothing

'MsgBox "Displayed reply all window for emails with subject: " & subjectToSearch
End Sub

[Aussiebear]

Welcome to VBAX dabrows. Thank you for posting your solution.