VBA to reply outlook from excel

  • Hi, I'm trying to combine 2 VBA found at other source to reply an email.
    VBA is to filter column "F" with text "email". Then locate emails subject at column "A" and use Outlook filter to reply with latest email received.
    The first email run success to display but fail to call second line from my worksheet.
    Below is my code.

    Sub ReplyMail()

    Dim OutlookApp As Object
    Dim OutMail As Object
    Dim Cell As Range

    ' Outlook's constant
    Const olFolderSentMail = 5

    ' Variables
    Dim IsOutlookCreated As Boolean
    Dim sFilter As String, sSubject As String

    Application.ScreenUpdating = False

    On Error GoTo cleanup

    For Each Cell In Columns("F").Cells.SpecialCells(xlCellTypeConstants)
    If Cell.Value Like "email" Then

    ' Get/create outlook object
    On Error Resume Next
    Set OutlookApp = GetObject(, "Outlook.Application")
    If Err Then
    Set OutlookApp = CreateObject("Outlook.Application")
    IsOutlookCreated = True
    End If
    On Error GoTo 0

    ' Restrict items
    sSubject = Cells(Cell.Row, "A").Value 'ActiveCell.Value
    sFilter = "[Subject] = '" & sSubject & "'"

    ' Main
    With OutlookApp.Session.GetDefaultFolder(olFolderInbox).Folders("ML").Items.Restrict(sFilter) 'error here :run-time error '440'
    If .Count > 0 Then
    .Sort "ReceivedTime", True
    With .Item(1).ReplyAll
    End With
    MsgBox "No emails found with Subject:" & vbLf & "'" & sSubject & "'"
    End If
    End With

    ' Quit Outlook instance if it was created by this code
    If IsOutlookCreated Then
    Set OutlookApp = Nothing
    End If
    End If
    Next Cell

    Set OutApp = Nothing
    Application.ScreenUpdating = True

    End Sub

  • Hello and Welcome to the Forum :smile:

    Your request is not extremely clear ...

    My understanding is that your Column F contains the indication ' email ' ...

    and the email address is located in Column A ...

    If that is the case ... your macro is missing the instruction :To

    in order for the email to be sent TO ... the right email address

    Hope this will help

    P.S. Perhaps you should post the two separate macros you would like to ' merge ' ...

    If you feel like saying "Thank You" for the help received, do not hesitate to click the "Like" icon ...just below...in the bottom right corner...:)

  • Thanks Carim for your reply,

    My worksheet is to record all vendor request then email the content to my colleague for further action.
    Using Ron Bruin VBA to filter which row to email is work perfectly.
    Now my bos is requesting to create new email if request receive by letter or reply back the vendor using email receive to inform their application has been approve or reject .

    My idea is :
    1- VBA to import email to my worksheet
    2- VBA to reply from worksheet and find the subject with latest date located at ML subfolfer (GetDefaultFolder(olFolderInbox).Folders("ML").Items).

    My current VBA that email to my collegue:

    1. Sub EMail()
    2. ' Works in Excel 2000, Excel 2002, Excel 2003, Excel 2007, Excel 2010, Outlook 2000, Outlook 2002, Outlook 2003, Outlook 2007, and Outlook 2010. Dim OutApp As Object Dim OutMail As Object Dim cell As Range Application.ScreenUpdating = False Set OutApp = CreateObject("Outlook.Application") On Error GoTo cleanup For Each cell In Columns("O").Cells.SpecialCells(xlCellTypeConstants) If cell.Value Like "email" Then Cells(cell.Row, "AR").FormulaR1C1 = "=Today()" Cells(cell.Row, "AR").Value = Cells(cell.Row, "AR").Value Set OutMail = OutApp.CreateItem(0) On Error Resume Next With OutMail '.SentOnBehalfOfName = "[email protected]" .to = Cells(cell.Row, "AA").Value .Cc = "[email protected];" & Cells(cell.Row, "AB").Value .Subject = "Vendor : " & Cells(cell.Row, "I").Value .HTMLBody = "Dear " & Cells(cell.Row, "AA").Value & "," & Please be informed that we have reviewed your request." '.Attachments.Add ("D:xx.docx") .Display 'Or use Display. End With On Error GoTo 0 Set OutMail = Nothing End If Next cell cleanup: Set OutApp = Nothing Application.ScreenUpdating = True End Sub

    'Found this VBA import email into Worksheet.

    'Found this VBA that filter latest subject and reply
    Only selected rows is required to reply our vendor. Below VBA need to adjust with filter function at column ("F").
    >For Each cell In Ash.Columns("F").Cells.SpecialCells(xlCellTypeConstants) If cell.Value Like "?*@?*.?*" _ And LCase(cell.Offset(0, 1).Value) = "yes" Then