none
Extract two lines from Outlook email body - can only extract the first line VBA 2010 RRS feed

  • Question

  • Hi,

      I would like to extract two lines of text from the body of an Outlook email.

    From the following email body ……..

    Site Name : BROADWAY SER/STN

    Site Code : G444

    Site Type : Coleman SITES

    Job Ref : HB3815846

    Shipping ID : 630311

    Serial No. : 209 663 969

    Fault : M5 Not reading "ALL CARDS"

    Serial No. 5 : 209 665 105

    Fault : Enter button stuck.

    I would like to extract the two lines:

    “ M5 Not reading "ALL CARDS"

    and…

    “Enter button stuck”,  

       I would appreciate any help in providing a solution based on the code I already have, illustrated below.

    Sub CopyToExcel()
    Dim olItem As Outlook.MailItem
    Dim xlApp As Object
    Dim xlWB As Object
    Dim xlSheet As Object
    Dim vText As Variant
    Dim sText As String
    Dim vItem As Variant
    Dim i As Long
    Dim rCount As Long
    Dim bXStarted As Boolean
    Const strPath As String = "O:\FSR\_excel\From_email_to_excel.xlsm"        
    
        On Error Resume Next
        Set olItem = ActiveExplorer.Selection
        Set xlApp = GetObject(, "Excel.Application")
        If Err <> 0 Then
            Application.StatusBar = "Please wait while Excel source is opened ... "
            Set xlApp = CreateObject("Excel.Application")
            bXStarted = True
        End If
        On Error GoTo 0
        'Open the workbook to input the data
        Set xlWB = xlApp.Workbooks.Open(strPath)
        Set xlSheet = xlWB.Sheets("sheet1")
    
        'Process the message record
        For Each olItem In Application.ActiveExplorer.Selection
        sText = olItem.Body
        vText = Split(sText, Chr(13))
        'Find the next empty line of the worksheet
        rCount = xlSheet.Range("A" & xlSheet.Rows.Count).End(-4162).Row
        rCount = rCount + 1
    
        'Check each line of text in the message body
        For i = UBound(vText) To 0 Step -1
    
            If InStr(1, vText(i), "Job Ref :") > 0 Then
                vItem = Split(vText(i), Chr(58))
                xlSheet.Range("A" & rCount) = Trim(vItem(1))
            End If
    
            If InStr(1, vText(i), "Serial No. :") > 0 Then
                vItem = Split(vText(i), Chr(58))
                xlSheet.Range("C" & rCount) = Trim(vItem(1))
            End If
    
            If InStr(1, vText(i), "Serial No. 1 :") > 0 Then
                vItem = Split(vText(i), Chr(58))
                xlSheet.Range("F" & rCount) = Trim(vItem(1))
            End If
    
            If InStr(1, vText(i), "Serial No. 2 :") > 0 Then
                vItem = Split(vText(i), Chr(58))
                xlSheet.Range("G" & rCount) = Trim(vItem(1))
            End If
    
            If InStr(1, vText(i), "Site Name :") > 0 Then
                vItem = Split(vText(i), Chr(58))
                xlSheet.Range("I" & rCount) = Trim(vItem(1))
            End If
    
            If InStr(1, vText(i), "Fault :") > 0 Then
                vItem = Split(vText(i), Chr(58))
                xlSheet.Range("K" & rCount) = Trim(vItem(1))
            
            End If
                  
            
        Next i
        xlWB.Save
        Next olItem
        If bXStarted Then
            xlApp.Quit
        End If
    
        Set xlApp = Nothing
        Set xlWB = Nothing
        Set xlSheet = Nothing
    End Sub



    • Edited by Becky_Granger Monday, January 20, 2014 1:22 PM
    • Moved by Yang,Chenfei Tuesday, January 21, 2014 1:45 AM Outlook related!
    Monday, January 20, 2014 1:19 PM

Answers

  • Try splitting on vbcrlf instead of just char(13)


    Bob - www.crowcoder.com

    Monday, January 20, 2014 1:56 PM
  • I very much appreciate the quick response Molku. As time is pressing and I don't know VB well enough to implement your answer could you indulge me and provide a line of code - based on what I already - have to illustrate your. I hope this is not construed as idleness on my part. I will investigate the answer fully in time and hopefully be in a position to assist others one day.   

    Rbie has provided an example using vbCrLf. This is just a shortcut convenience that represents both a carriage return and a line feed. Char(13) is just a carriage return and will not separate the lines of text if they are terminated with both a carriage return and a line feed.

    vbCrLf is the same as doing : Char(13) & Char(10)


    Bob - www.crowcoder.com

    Monday, January 20, 2014 2:51 PM
  • As stated above I forgot that you can't combine statements in vba

    so this

     For Each y As String In vText

    should be

    dim y as string

    for each y in vtext



    Tuesday, January 21, 2014 6:34 AM
  • Hello Becky,

    There are two more ways for parsing the message content:

    1. The Body property. Now you are trying to parse a raw string.

    2. The HTMLBody property. Provides access to the raw html markup of your message.

    2. The Word object model. You can get an instance of the Document class from the Word object model which represents a message content. The WordEditor property of the Inspector class can be used for getting a Document. Note, the WordEditor property is only valid if the IsWordMail method returns True and the EditorType property is olEditorWord. The returned WordDocument object provides access to most of the Word object model. For example:

    Set myInspector = Item.GetInspector
    Set WordDoc = myInspector.WordEditor
    

    Finally, please take a look at the Chapter 17: Working with Item Bodies in MSDN. It described all possible ways for parsing bodies and provides a sample code in VBA.

    Function ParseTextLinePair _
      (strSource As String, strLabel As String)
        Dim intLocLabel As Integer
        Dim intLocCRLF As Integer
        Dim intLenLabel As Integer
        Dim strText As String
        intLocLabel = InStr(strSource, strLabel)
        intLenLabel = Len(strLabel)
            If intLocLabel > 0 Then
            intLocCRLF = InStr(intLocLabel, strSource, vbCrLf)
            If intLocCRLF > 0 Then
                intLocLabel = intLocLabel + intLenLabel
                strText = Mid(strSource, _
                                intLocLabel, _
                                intLocCRLF - intLocLabel)
            Else
                intLocLabel = _
                  Mid(strSource, intLocLabel + intLenLabel)
            End If
        End If
        ParseTextLinePair = Trim(strText)
    End Function
    

     
    Tuesday, January 21, 2014 12:30 PM

All replies

  • Try splitting on vbcrlf instead of just char(13)


    Bob - www.crowcoder.com

    Monday, January 20, 2014 1:56 PM
  • This seems to work just fine

    Dim vText() As String = Split(sText, vbCrLf)
    rCount = xlSheet.Range("K" & xlSheet.Rows.Count).End(-4162).Row
    rCount = rCount + 1
    
            Dim vitem() As String
    
            For Each y As String In vText
                vitem = Split(y, ":")
                Select Case vitem(0).Trim
                    Case "Job Ref"
                          xlSheet.Range("A" & rCount) = Trim(vItem(1))
                    Case "Serial No."
                          xlSheet.Range("C" & rCount) = Trim(vItem(1))
                    Case "Serial No. 1"
                          xlSheet.Range("F" & rCount) = Trim(vItem(1))
                    Case "Serial No. 2"
                          xlSheet.Range("G" & rCount) = Trim(vItem(1))
                    Case "Site Name"
                          xlSheet.Range("I" & rCount) = Trim(vItem(1))
                    Case "Fault"
                         xlSheet.Range("K" & rCount) = Trim(vItem(1))
                End Select
            Next



    Monday, January 20, 2014 2:30 PM
  • I very much appreciate the quick response Molku. As time is pressing and I don't know VB well enough to implement your answer could you indulge me and provide a line of code - based on what I already - have to illustrate your. I hope this is not construed as idleness on my part. I will investigate the answer fully in time and hopefully be in a position to assist others one day.   
    Monday, January 20, 2014 2:34 PM
  • I very much appreciate the quick response Molku. As time is pressing and I don't know VB well enough to implement your answer could you indulge me and provide a line of code - based on what I already - have to illustrate your. I hope this is not construed as idleness on my part. I will investigate the answer fully in time and hopefully be in a position to assist others one day.   

    Rbie has provided an example using vbCrLf. This is just a shortcut convenience that represents both a carriage return and a line feed. Char(13) is just a carriage return and will not separate the lines of text if they are terminated with both a carriage return and a line feed.

    vbCrLf is the same as doing : Char(13) & Char(10)


    Bob - www.crowcoder.com

    Monday, January 20, 2014 2:51 PM
  • The code provided by way of a solution - thank you Rbie - reports a syntax error for :

    Dim vText() As String = Split(sText, vbCrLf)

    ???

    Monday, January 20, 2014 3:06 PM
  • By the way I am running this from VBA 2010 (Outlook)

    Monday, January 20, 2014 3:09 PM
  • ah right you can't combine instruction in VBA

    so

    try

    Dim vText() As String

    vtext = Split(sText, vbCrLf)

    Monday, January 20, 2014 3:19 PM
  • hmm vba so this will probably return an error aswell

     vitem = Split(y, ":")

    if so change to

    vitem = Split(y, Chr(58))

    on second thought it shouldn't return an error :-)



    • Edited by Rbie Monday, January 20, 2014 3:24 PM
    Monday, January 20, 2014 3:22 PM
  • That seems to have sorted that error Rbie. Now reporting a sytnax error for:

    For Each y As String In xText

     

    Monday, January 20, 2014 3:30 PM
  • Correction: The syntax error is for .....

    For Each y As String In vText  and not

    For Each y As String In xText as above.

    I have declared vtext . Any ideas as to what should be the correct syntax in VBA 2010 appreciated - thanks. 

    Monday, January 20, 2014 3:47 PM
  • Thanks for your help guys. As syntax errors are preventing me from testing the solution I'm unable to mark as answered. Hopefully an administrator will apportion points as he/she sees fit. Many thanks for your help.
    Monday, January 20, 2014 4:26 PM
  • Hi,

    Since this forum is just to discuss VB.NET issue. I will move this thread to Outlook for Developers Forum. Where you can contact many experts about this issue.

    Thanks for your understanding!

    Have a nice time!

    Regards,


    We are trying to better understand customer views on social support experience, so your participation in this interview project would be greatly appreciated if you have time. Thanks for helping make community forums a great place.
    Click HERE to participate the survey.

    Tuesday, January 21, 2014 1:45 AM
  • As stated above I forgot that you can't combine statements in vba

    so this

     For Each y As String In vText

    should be

    dim y as string

    for each y in vtext



    Tuesday, January 21, 2014 6:34 AM
  • Hello Becky,

    There are two more ways for parsing the message content:

    1. The Body property. Now you are trying to parse a raw string.

    2. The HTMLBody property. Provides access to the raw html markup of your message.

    2. The Word object model. You can get an instance of the Document class from the Word object model which represents a message content. The WordEditor property of the Inspector class can be used for getting a Document. Note, the WordEditor property is only valid if the IsWordMail method returns True and the EditorType property is olEditorWord. The returned WordDocument object provides access to most of the Word object model. For example:

    Set myInspector = Item.GetInspector
    Set WordDoc = myInspector.WordEditor
    

    Finally, please take a look at the Chapter 17: Working with Item Bodies in MSDN. It described all possible ways for parsing bodies and provides a sample code in VBA.

    Function ParseTextLinePair _
      (strSource As String, strLabel As String)
        Dim intLocLabel As Integer
        Dim intLocCRLF As Integer
        Dim intLenLabel As Integer
        Dim strText As String
        intLocLabel = InStr(strSource, strLabel)
        intLenLabel = Len(strLabel)
            If intLocLabel > 0 Then
            intLocCRLF = InStr(intLocLabel, strSource, vbCrLf)
            If intLocCRLF > 0 Then
                intLocLabel = intLocLabel + intLenLabel
                strText = Mid(strSource, _
                                intLocLabel, _
                                intLocCRLF - intLocLabel)
            Else
                intLocLabel = _
                  Mid(strSource, intLocLabel + intLenLabel)
            End If
        End If
        ParseTextLinePair = Trim(strText)
    End Function
    

     
    Tuesday, January 21, 2014 12:30 PM
  • Hi,

    Since we haven't heard from you for a long time, I temporarily close this case. I mark useful reply as answer. If you have any concerns, please free feel to reopen it or submit a new question.

    Thanks for your understanding.

    Best regards

    Fei 


    We are trying to better understand customer views on social support experience, so your participation in this interview project would be greatly appreciated if you have time. Thanks for helping make community forums a great place.
    Click HERE to participate the survey.

    Monday, January 27, 2014 1:21 PM
    Moderator