Posts by Rakuso

    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:

    Sub EMail()  
     ' 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


    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