none
How do I set up a condition using the email subject so that the email will only extract emails with the same subject. RRS feed

  • Question

  • How do I set up a condition using the email subject so that the email will only extract emails with the same subject.

    However the subject varies, the bold part is static while the not bold part is dynamic. 

    Example of email subject: Request For Information REF: CR15-06000

    For example scenario: I have 5 email in my inbox, 3 of them have the subject Request For Information REF: CR15-06021, Request For Information REF: CR15-06343 and Request For Information REF: CR15-060456 while the other two have other subject.

    Sub ExportToExcel()
    On Error GoTo ErrHandler
    Dim appExcel As Object
    Dim wkb As Object
    Dim wks As Object
    Dim rng As Object
    Dim strSheet As String
    Dim strPath As String
    
    
    Dim intRowCounter As Integer
    Dim intColumnCounter As Integer
    Dim msg As Outlook.MailItem
            
    
    Dim nms As Outlook.NameSpace
    Dim fld As Outlook.MAPIFolder
    Dim itm As Object
    strSheet = "Vulnerability Advisory_2015.xlsx"
    strPath = "D:\"
    strSheet = strPath & strSheet
    Debug.Print strSheet   'Select export folder
    Set nms = Application.GetNamespace("MAPI")
    Set fld = nms.PickFolder   'Handle potential errors with Select Folder dialog box.
    If fld Is Nothing Then
    MsgBox "There are no mail messages to export", vbOKOnly, _
    "Error"
    Exit Sub
    ElseIf fld.DefaultItemType <> olMailItem Then
    MsgBox "There are no mail messages to export", vbOKOnly, _
    "Error"
    Exit Sub
    ElseIf fld.Items.Count = 0 Then
    MsgBox "There are no mail messages to export", vbOKOnly, _
    "Error"
    Exit Sub
    End If   'Open and activate Excel workbook.
    Set appExcel = CreateObject("Excel.Application")
    appExcel.Workbooks.Open (strSheet)
    Set wkb = appExcel.ActiveWorkbook
    Set wks = wkb.Sheets(1)
    
    wks.Activate
    
    appExcel.Application.Visible = True   'Copy field items in mail folder.
    intRowCounter = wks.UsedRange.Rows.Count
    For Each itm In fld.Items
    intColumnCounter = 1
    Set msg = itm
    intRowCounter = intRowCounter + 1
    intColumnCounter = intColumnCounter + 1
    wks.Rows(intRowCounter).Insert Shift:=xlup, CopyOrigin:=xlFormatFromLeftOrAbove
    Set rng = wks.Cells(intRowCounter, intColumnCounter)
    rng.Value = msg.Subject = ("Request For Information REF: CR15")
    intColumnCounter = intColumnCounter + 1
    Set rng = wks.Cells(intRowCounter, intColumnCounter)
    rng.Value = msg.ReceivedTime
    intColumnCounter = intColumnCounter + 2
    Set rng = wks.Cells(intRowCounter, intColumnCounter)
    rng.Value = msg.Body
    
    Next itm
    Set appExcel = Nothing
    Set wkb = Nothing
    Set wks = Nothing
    Set rng = Nothing
    Set msg = Nothing
    Set nms = Nothing
    Set fld = Nothing
    Set itm = Nothing
    Exit Sub
    ErrHandler:  If Err.Number = 1004 Then
    MsgBox strSheet & " doesn't exist", vbOKOnly, _
    "Error"
    Else
    MsgBox Err.Number & "; Description: ", vbOKOnly, _
    "Error"
    End If
    Set appExcel = Nothing
    Set wkb = Nothing
    Set wks = Nothing
    Set rng = Nothing
    Set msg = Nothing
    Set nms = Nothing
    Set fld = Nothing
    Set itm = Nothing
    
    End Sub
    


    • Edited by Derrick319 Thursday, July 16, 2015 6:04 AM
    Thursday, July 16, 2015 5:36 AM

Answers

  • To find any message with a subject starting with "Request For Information REF:" , try changing:

    rng.Value = msg.Subject = ("Request For Information REF: CR15")
    intColumnCounter = intColumnCounter + 1
    Set rng = wks.Cells(intRowCounter, intColumnCounter)
    rng.Value = msg.ReceivedTime
    intColumnCounter = intColumnCounter + 2
    Set rng = wks.Cells(intRowCounter, intColumnCounter)
    rng.Value = msg.Body

    to

        If msg.Subject Like "Request For Information REF:*" Then
            Rng.Value = msg.Subject
            Rng.Offset(0, 1).Value = msg.ReceivedTime
            Rng.Offset(0, 2).Value = msg.Body ' or maybe Offset(0, 3)
        End If


    Thursday, July 16, 2015 6:22 PM