Parse Function

A

angel56

New Member
Joined
Dec 12, 2007
Messages
4
I'm using Excel 2007.I'm trying to retrive the body of messages inside a folder called Erika to an Excel sheet. The code run without errors but does not parse. As I step through the code my ParseTextLinePair is always "". Can anyone help me?

Code: 
Sub Outlook_strip_all_data_to_excel()

Dim Fldr As MAPIFolder
Dim myOlApp As Outlook.Application
Dim myNamespace As Outlook.Namespace
Dim myRecipient As Outlook.Recipient

Dim olMail As Variant
Dim i As Integer

Dim strIndex As String
Dim strEnterprise As String
Dim strCommercial As String
Dim strPublic As String
Dim strBasic_Silver As String
Dim strIPS As String
Dim strEDT As String
Dim strPS As String
Dim strSales_SAM As String


Application.ScreenUpdating = False

Set myOlApp = CreateObject("Outlook.Application")
Set myNamespace = myOlApp.GetNamespace("MAPI")
Set myRecipient = myNamespace.CreateRecipient("Mailbox - Rodriguez, Angel - Authorized Dell Representative - Outlook Today")
myRecipient.Resolve

On Error Resume Next
Set mbox = myNamespace.Folders("Mailbox - Rodriguez, Angel - Authorized Dell Representative- Outlook Today")
Set inbox = mbox.Folders("Inbox")
Set Fldr = mbox.Folders("Erika")


i = 6
' i used for starting row in spreadsheet

For Each olMail In Fldr.Items

If InStr(olMail.Body, "a") > 0 Then

ActiveSheet.Cells(i, 1).Value = olMail.ReceivedTime

' Each string below is a data item in the email
strIndex = ParseTextLinePair(olMail.Body, "Index: ")
strEnterprise = ParseTextLineDown(olMail.Body, "Enterprise", ") on")
strCommercial = ParseTextLinePair(olMail.Body, "Commercial: ")
strBasic_Silver = ParseTextLinePair(olMail.Body, "Basic_Silver: ")
strIPS = ParseTextLinePair(olMail.Body, "IPS: ")
strEDT = ParseTextLinePair(olMail.Body, "EDT: ")
strPS = ParseTextLinePair(olMail.Body, "PS: ")
strSales_SAM = ParseTextLinePair(olMail.Body, "Sales_SAM: ")
strClient = ParseTextLinePair(olMail.Body, "Client: ")
strCommercial = ParseTextLinePair(olMail.Body, "Commercial: ")
strPublic = ParseTextLinePair(olMail.Body, "Public: ")


'input to spreadsheet, all on same row next to received time
ActiveSheet.Cells(i, 2).Value = strIndex
ActiveSheet.Cells(i, 3).Value = strEnterprise
ActiveSheet.Cells(i, 4).Value = strCommercial
ActiveSheet.Cells(i, 5).Value = strBasic_Silver
ActiveSheet.Cells(i, 6).Value = strIPS
ActiveSheet.Cells(i, 7).Value = strEDT
ActiveSheet.Cells(i, 9).Value = strPS
ActiveSheet.Cells(i, 10).Value = strSales - SAM
ActiveSheet.Cells(i, 11).Value = strClient
ActiveSheet.Cells(i, 12).Value = strCommercial
ActiveSheet.Cells(i, 13).Value = strPublic
'ActiveSheet.Cells(i, 14).Value = strSamCarTwo

i = i + 1

End If

Next olMail
Range("H3").Select
MsgBox "Completed Outlook Strip"

End Sub

Function ParseTextLinePair(strSource As String, strLabel As String)
Dim intLocLabel As Integer
Dim intLocCRLF As Integer
Dim intLenLabel As Integer
Dim strText As String

' locate the label in the source text
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

[code]
 

Excel Facts

How to find 2nd largest value in a column?
MAX finds the largest value. =LARGE(A:A,2) will find the second largest. =SMALL(A:A,3) will find the third smallest
Sort by date Sort by votes
Hi Angel56, in your function when you are looking for the vbCrLf the else statement (when vbCrLf is not found) you are setting the variable intLocLabel = Mid.... is that supposed to be strText = Mid...

Code: 
        If intLocCRLF > 0 Then
            intLocLabel = intLocLabel + intLenLabel
            strText = Mid(strSource, intLocLabel, intLocCRLF - intLocLabel)
        Else
            intLocLabel = Mid(strSource, intLocLabel + intLenLabel)
        End If
    End If

Are you just trying to parse from the label to the first Cr or Lf?
 
Last edited:
Upvote 0
If your function should return the string from the label to the first vbCrLf and if no vbCrLf then to the end of the string. You could use...

Code: 
Function ParseTextLinePair(strSource As String, strLabel As String) As String
On Error Resume Next
    Dim varTemp As Variant
    
    'set default value
    ParseTextLinePair = ""
    
    'locate label and split the message in two from the label
    varTemp = Split(strSource, strLabel, 2, vbTextCompare)
    
    'if label not found exit function
    If UBound(varTemp) = 0 Then Exit Function
    
    'return the string from the label to the first vbcrlf
    'if no vbcrlf then the whole string
    ParseTextLinePair = Trim(Split(varTemp, vbCrLf, 2, vbTextCompare)(0))
    
End Function
 
Upvote 0
Thanks VBA Noob... just wanted to update the above code in case anyone wants to use, left off an index.

Code: 
Function ParseTextLinePair(strSource As String, strLabel As String) As String
On Error Resume Next
    Dim varTemp As Variant
    
    'set default value
    ParseTextLinePair = ""
    
    'locate label and split the message in two from the label
    varTemp = Split(strSource, strLabel, 2, vbTextCompare)
    
    'if label not found exit function
    If UBound(varTemp) = 0 Then Exit Function
    
    'return the string from the label to the first vbcrlf
    'if no vbcrlf then the whole string
    ParseTextLinePair = Trim(Split(varTemp(1), vbCrLf, 2, vbTextCompare)(0))
    
End Function
 
Upvote 0
You must log in or register to reply here.

Similar threads

sharky12345
  • Question
Type Mismatch Error 13
Replies
2
Views
545
Rick Rothstein
Rick Rothstein
H
  • Question
copy Outlook Body and paste match Destination Formatting to excel cell
Replies
1
Views
983
hajiali
H
J
  • Question
Input box for search subject
Replies
1
Views
395
JLGWhiz
JLGWhiz
J
  • Question
Need InputBox to input value into another function in VBA
Replies
1
Views
2K
Joe4
Joe4
A
  • Question
Macro Excel 2007
Replies
2
Views
657
angel56
A

Forum statistics

Threads
1,216,108
Messages
6,128,872
Members
449,475
Latest member
Parik11

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top