Solved

parsing an outlook file

Posted on 2004-10-21
266 Views
Last Modified: 2010-05-02
Hi,

I have a little challenging task.  I gotta open outlook from my vb code, go to the inbox folder, and pull out an email sent from an oracle database containing daily stats.  Then I gotta parse that email.  I started with opening outlook...but none of the 2 or 3 code snippets i got from internet worked.

My main qs is how should i approach about parsing the email.  The email format is same and looks like following:


Report of Act/Deactivations
Report of Total subscribers on 2004-10-19
    5000

Report of Activations done on 2004-10-19
    23

Report of Activations done on 2004-10-19 by hour
00,0
01,3
02,1
03,0
04,2
05,3
06,1
07,4
.
.
.

Report of Acttivations done on 2004-10-19 by site

I need to store values of Total Subscribers, Activations done and activations done by hr into vb variables.

So what should I do, should i copy email to some text file (i dont know how to do that) and try to parse it or is there any way to directly extract data from the outlook and store them into vb variables.


Has anybody came across something like above before.

Any help would be appreciated,

Mansoor
0
Question by:machatha
    13 Comments
     
    LVL 28

    Expert Comment

    by:vinnyd79
    maybe this example can help:


    ' add a reference to Microsoft Outlook Object library

    Private Sub Command1_Click()
    Dim oOutlook As Outlook.Application
    Dim oNs As Outlook.NameSpace
    Dim oFldr As Outlook.MAPIFolder
    Dim oMessage As Outlook.MailItem

    Dim TotalSubscribers As String
    Dim Activations As String
    Dim arrActivationsByHr() As String
    Dim arrBody() As String
    Dim i As Integer, cnt As Integer

    cnt = 1

    On Error GoTo ErrorHandler
     
    'get reference to inbox
    Set oOutlook = New Outlook.Application
    Set oNs = oOutlook.GetNamespace("MAPI")
    Set oFldr = oNs.GetDefaultFolder(olFolderInbox)
     
       For Each oMessage In oFldr.Items
       ' look at subject to find the mail you are looking for
           If InStr(oMessage.Subject, "DAILY REPORT") > 0 Then
               'Message found split body by lines
                arrBody = Split(oMessage.Body, vbCrLf)
                For i = 0 To UBound(arrBody)
                If cnt > 1 Then GoTo HourCheck
                    ' check for line before value
                    If InStr(arrBody(i), "Report of Total subscribers") > 0 Then
                        TotalSubscribers = Trim$(arrBody(i + 1))
                        GoTo GetNext
                    End If
                    ' check for line before value
                    If InStr(arrBody(i), "Report of Activations done on") > 0 Then
                        ' check for hour on line
                        If InStr(arrBody(i), "hour") = 0 Then
                            Activations = Trim$(arrBody(i + 1))
                        Else
    HourCheck:
                            ' add hourly vales to array
                            ReDim Preserve arrActivationsByHr(cnt)
                            arrActivationsByHr(cnt) = Trim$(arrBody(i + 1))
                            cnt = cnt + 1
                            If cnt = 25 Then GoTo Cleanup
                        End If
                    End If

    GetNext:
                Next i
           DoEvents

    End If
    Cleanup:

    Next oMessage
       
    Set oMessage = Nothing
    Set oFldr = Nothing
    Set oNs = Nothing
    Set oOutlook = Nothing
       
    ' results
    MsgBox TotalSubscribers
    MsgBox Activations

    For i = 1 To UBound(arrActivationsByHr)
        MsgBox arrActivationsByHr(i)
    Next i

    Exit Sub

    ErrorHandler:
       MsgBox Err.Description
    End Sub
    0
     

    Author Comment

    by:machatha
    Hi vinnyd79,

    Thanks your code is great.  There are two issues though,

    i) I wanna process the email on a day-by-day basis.  Email for yesterday's stats gets recieved by today morning.  So instead of running a for loop going through all messages i wanna search for only a particular date's message.  Now is there any way to iterate through the email list until the email containing that date is found and then break out of for loop. (for example start iterating until found "Report of Total subscribers on 2004-10-20" and once 2004-10-20 is there just stop iteration.

    actually if you could tell me how to break out of a for loop in visual basic that will be sufficient.

    ii)when i ran this code, MS Exchange gave me these warnings:

    "A program is trying to access e-mail addresses you have stored in Outlook. Do you want to allow this?"  

    Is there any way to turn off this message or automatically make VB to click yes on it each time it pops up (I wanna automate may app as much as possible)

    Sincerely,

    Mansoor
    0
     
    LVL 28

    Accepted Solution

    by:
    You can add an "Exit For" in before the last "End if"

    ....
    GetNext:
                Next i
           DoEvents
        Exit For    <----
    End If
    Cleanup:
    Next oMessage
    ......

    The message is from Outlooks security update.What version of Outlook are you using?

    0
     
    LVL 28

    Expert Comment

    by:vinnyd79
    If you only want to process the previous days file maybe you could use something like this:

    Private Sub Command1_Click()
    Dim oOutlook As Outlook.Application
    Dim oNs As Outlook.NameSpace
    Dim oFldr As Outlook.MAPIFolder
    Dim oMessage As Outlook.MailItem

    Dim TotalSubscribers As String
    Dim Activations As String
    Dim arrActivationsByHr() As String
    Dim arrBody() As String
    Dim i As Integer, cnt As Integer
    Dim TargetDate As Date

    TargetDate = Format(Date - 1, "YYYY-MM-DD")

    cnt = 1

    On Error GoTo ErrorHandler
     
    'get reference to inbox
    Set oOutlook = New Outlook.Application
    Set oNs = oOutlook.GetNamespace("MAPI")
    Set oFldr = oNs.GetDefaultFolder(olFolderInbox)
     
       For Each oMessage In oFldr.Items
       ' look at subject to find the mail you are looking for
       
           If InStr(oMessage.Subject, "Report of Total subscribers on " & TargetDate) > 0 Then
               'Message found split body by lines
                arrBody = Split(oMessage.Body, vbCrLf)
                For i = 0 To UBound(arrBody)
                If cnt > 1 Then GoTo HourCheck
                    ' check for line before value
                    If InStr(arrBody(i), "Report of Total subscribers") > 0 Then
                        TotalSubscribers = Trim$(arrBody(i + 1))
                        GoTo GetNext
                    End If
                    ' check for line before value
                    If InStr(arrBody(i), "Report of Activations done on") > 0 Then
                        ' check for hour on line
                        If InStr(arrBody(i), "hour") = 0 Then
                            Activations = Trim$(arrBody(i + 1))
                        Else
    HourCheck:
                            ' add hourly vales to array
                            ReDim Preserve arrActivationsByHr(cnt)
                            arrActivationsByHr(cnt) = Trim$(arrBody(i + 1))
                            cnt = cnt + 1
                            If cnt = 25 Then GoTo Cleanup
                        End If
                    End If
    GetNext:
                Next i
           DoEvents
    Exit For
    End If
    Cleanup:

    Next oMessage
       
    Set oMessage = Nothing
    Set oFldr = Nothing
    Set oNs = Nothing
    Set oOutlook = Nothing
       
    ' results
    MsgBox TotalSubscribers
    MsgBox Activations

    For i = 1 To UBound(arrActivationsByHr)
        MsgBox arrActivationsByHr(i)
    Next i

    Exit Sub

    ErrorHandler:
       MsgBox Err.Description
    End Sub
    0
     

    Author Comment

    by:machatha
    Hi,

    The "Exit For" for worked great.  I am using Outlook 2003.  So do i need to do some kind of security update to get rid of those messages?

    Mansoor
    0
     
    LVL 28

    Expert Comment

    by:vinnyd79
    Actually the security update is what is causing the messages. I don't know if there is an easy way to turn it off in 2003. There is alot of good info on this here:

    http://www.dimastr.com/redemption/home.htm
    http://www.outlookcode.com/d/vb.htm
    http://www.slipstick.com/outlook/esecup.htm#autosec

    There is also a freeware utility here for clicking yes to the message.It includes a vb example on use:
    http://www.contextmagic.com/express-clickyes/

    0
     

    Author Comment

    by:machatha
    there's one prob though. If i get a meeting request in my outlook the vb code thinks that Message = Nothing and therefore crashes.  Is there any workaround this?  Maybe I can make a separate folder called Stats and have my oracle messages sent to that folder and then parse that folder.  How would that change the following code:

     Dim oOutlook As Outlook.Application
     Dim oNs As Outlook.NameSpace
     Dim oFldr As Outlook.MAPIFolder
     Dim oMessage As Outlook.MailItem


    Sincerely,

    Mansoor
       
    0
     
    LVL 28

    Expert Comment

    by:vinnyd79
    Have you tried testing for nothing and if so,jumping to the next message with a Goto?

       For Each oMessage In oFldr.Items
        If oMessage Is Nothing Then GoTo Cleanup
    0
     

    Author Comment

    by:machatha
    Yeah I tried that, the problem is that the code crashes at the following point:


    GetNext:
                Next i
           DoEvents
    Exit For
    End If
    Cleanup:

     Next oMessage <--------- (code crashes here)

    Is there any way to check if the Next Message is Nothing.  thanks,

    Mansoor
    0
     
    LVL 28

    Expert Comment

    by:vinnyd79
    How about Checking if the message is Nothing in the error Handler,and if it is resume next,then check for nothing again.If nothing then Goto Cleanup and get the next message:


    Private Sub Command1_Click()
    Dim oOutlook As Outlook.Application
    Dim oNs As Outlook.NameSpace
    Dim oFldr As Outlook.MAPIFolder
    Dim oMessage As Outlook.MailItem

    Dim TotalSubscribers As String
    Dim Activations As String
    Dim arrActivationsByHr() As String
    Dim arrBody() As String
    Dim i As Integer, cnt As Integer
    Dim TargetDate As Date

    TargetDate = Format(Date - 1, "YYYY-MM-DD")

    cnt = 1

    On Error GoTo ErrorHandler
     
    'get reference to inbox
    Set oOutlook = New Outlook.Application
    Set oNs = oOutlook.GetNamespace("MAPI")
    Set oFldr = oNs.GetDefaultFolder(olFolderInbox)
     
       For Each oMessage In oFldr.Items
       ' look at subject to find the mail you are looking for
       If oMessage Is Nothing Then GoTo Cleanup    '  <<<< Jump to next message
           If InStr(oMessage.Subject, "Report of Total subscribers on " & TargetDate) > 0 Then
               'Message found split body by lines
                arrBody = Split(oMessage.Body, vbCrLf)
                For i = 0 To UBound(arrBody)
                If cnt > 1 Then GoTo HourCheck
                    ' check for line before value
                    If InStr(arrBody(i), "Report of Total subscribers") > 0 Then
                        TotalSubscribers = Trim$(arrBody(i + 1))
                        GoTo GetNext
                    End If
                    ' check for line before value
                    If InStr(arrBody(i), "Report of Activations done on") > 0 Then
                        ' check for hour on line
                        If InStr(arrBody(i), "hour") = 0 Then
                            Activations = Trim$(arrBody(i + 1))
                        Else
    HourCheck:
                            ' add hourly vales to array
                            ReDim Preserve arrActivationsByHr(cnt)
                            arrActivationsByHr(cnt) = Trim$(arrBody(i + 1))
                            cnt = cnt + 1
                            If cnt = 25 Then GoTo Cleanup
                        End If
                    End If
    GetNext:
                Next i
           DoEvents
    Exit For
    End If
    Cleanup:

    Next oMessage
       
    Set oMessage = Nothing
    Set oFldr = Nothing
    Set oNs = Nothing
    Set oOutlook = Nothing
       
    ' results
    MsgBox TotalSubscribers
    MsgBox Activations

    For i = 1 To UBound(arrActivationsByHr)
        MsgBox arrActivationsByHr(i)
    Next i

    Exit Sub

    ErrorHandler:
        If oMessage Is Nothing Then  ' <<< If Nothing resume next
            Resume Next
        End If

       MsgBox Err.Description
       
    End Sub
    0
     

    Author Comment

    by:machatha
    Thanks,

    This worked perfectly until another bug came up.  The prob is that sometimes Oracle is messing up the format.  Until now this was the format the program was getting:

    Report of Activations done on 2004-10-19 by hour
    00,0
    01,3
    02,1
    03,0
    ...
    23,2

    But recently i got email from oracle in this format:

    Report of Activations done on 2004-10-19 by hour 00,0 01,3
    02,1
    03,0
    ...
    23,2

    I putted a condition which checks for fist two letters to by "23" and breaks out of loop.  But the prob is that i am having trouble parsing the top line since "00,0 01,3" appear on the same line as the title sentence.

    Mansoor
    0
     
    LVL 28

    Expert Comment

    by:vinnyd79
    Give this a try. I marked the section where i made changes:

    Private Sub Command1_Click()
    Dim oOutlook As Outlook.Application
    Dim oNs As Outlook.NameSpace
    Dim oFldr As Outlook.MAPIFolder
    Dim oMessage As Outlook.MailItem

    Dim TotalSubscribers As String
    Dim Activations As String
    Dim arrActivationsByHr() As String
    Dim arrBody() As String
    Dim i As Integer, cnt As Integer
    Dim TargetDate As Date

    TargetDate = Format(Date - 1, "YYYY-MM-DD")

    cnt = 1

    On Error GoTo ErrorHandler
     
    'get reference to inbox
    Set oOutlook = New Outlook.Application
    Set oNs = oOutlook.GetNamespace("MAPI")
    Set oFldr = oNs.GetDefaultFolder(olFolderInbox)
     
       For Each oMessage In oFldr.Items
       ' look at subject to find the mail you are looking for
       If oMessage Is Nothing Then GoTo Cleanup    '  <<<< Jump to next message
           If InStr(oMessage.Subject, "Report of Total subscribers on " & TargetDate) > 0 Then
               'Message found split body by lines
                arrBody = Split(oMessage.Body, vbCrLf)
                For i = 0 To UBound(arrBody)
                If cnt > 1 Then GoTo HourCheck
                    ' check for line before value
                    If InStr(arrBody(i), "Report of Total subscribers") > 0 Then
                        TotalSubscribers = Trim$(arrBody(i + 1))
                        GoTo GetNext
                    End If
                    ' check for line before value
                    If InStr(arrBody(i), "Report of Activations done on") > 0 Then
                        ' check for hour on line
                        If InStr(arrBody(i), "hour") = 0 Then
                            Activations = Trim$(arrBody(i + 1))
                        Else
    HourCheck:
    '''////////////////////////////////////////////////////////////////////////// ' changes
                            ' add hourly vales to array
                            Dim pos As Integer
                            ' get position of first space after hour
                            pos = InStr(arrBody(i), "hour") + 4
                            ' check for data after "hour"
                            If Trim$(Mid$(arrBody(i), pos)) <> "" Then
                                ' have data, so split the data by a space
                                Dim arrLn() As String, x As Integer
                                arrLn = Split(Trim$(Mid$(arrBody(i), pos)), " ")
                                ' loop through arrLn adding to arrActivationsByHr array
                                For x = 0 To UBound(arrLn)
                                    ReDim Preserve arrActivationsByHr(cnt)
                                    arrActivationsByHr(cnt) = arrLn(x)
                                    cnt = cnt + 1
                                Next x
                                cnt = cnt + 1
                            End If
    ''' /////////////////////////////////////////////////////////////////////////  ' end changes
                            ReDim Preserve arrActivationsByHr(cnt)
                            arrActivationsByHr(cnt) = Trim$(arrBody(i + 1))
                            cnt = cnt + 1
                            If cnt = 25 Then GoTo Cleanup
                        End If
                    End If
    GetNext:
                Next i
           DoEvents
    Exit For
    End If
    Cleanup:

    Next oMessage
       
    Set oMessage = Nothing
    Set oFldr = Nothing
    Set oNs = Nothing
    Set oOutlook = Nothing
       
    ' results
    MsgBox TotalSubscribers
    MsgBox Activations

    For i = 1 To UBound(arrActivationsByHr)
        MsgBox arrActivationsByHr(i)
    Next i

    Exit Sub

    ErrorHandler:
        If oMessage Is Nothing Then  ' <<< If Nothing resume next
            Resume Next
        End If

       MsgBox Err.Description
       
    End Sub
    0
     

    Author Comment

    by:machatha
    Hi,

    Thanks for your help.  Another prob occured.  The code works fine on the original machine.  However after it was installed on another machine, a prob came up.  On the original machine it reads and parses the email from top towards the bottom.  However on the new machine for some weire reason it starts from the oldest email and comes towards current email (which is not a prob in short run but is becoming a prob as email number volume is increasing).  I tried Inbox options, editing the email account and all the settings on Outlook i could play with but didnt work.

    I was thinking may be I can make a Stats folder and have the code parse that folder.  In that case is it easy to check "Stats" instead of Inbox from the code.  I gues this line needs to be changed:
    Set oFldr = oNs.GetDefaultFolder(olFolderInbox)

    but i dont know what to put instead of olFolderInbox?

    Again thanks for all the help,

    Mansoor
    0

    Write Comment

    Please enter a first name

    Please enter a last name

    We will never share this with anyone.

    Featured Post

    Course: JavaScript Coding - Massive 12-Part Bundle

    Regardless of your programming skill level, you'll go from basics to advanced concepts in a vast array of JavaScript subjects including Sammy.js, Agility.js, Ember.js, Node.js, jQuery, AJAX, Extjs, AngularJS, Knockout.js, and JSON.

    Suggested Solutions

    The debugging module of the VB 6 IDE can be accessed by way of the Debug menu item. That menu item can normally be found in the IDE's main menu line as shown in this picture.   There is also a companion Debug Toolbar that looks like the followin…
    When trying to find the cause of a problem in VBA or VB6 it's often valuable to know what procedures were executed prior to the error. You can use the Call Stack for that but it is often inadequate because it may show procedures you aren't intereste…
    Get people started with the process of using Access VBA to control Outlook using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Microsoft Outlook. Using automation, an Access applic…
    Show developers how to use a criteria form to limit the data that appears on an Access report. It is a common requirement that users can specify the criteria for a report at runtime. The easiest way to accomplish this is using a criteria form that a…

    884 members asked questions and received personalized solutions in the past 7 days.

    Join the community of 500,000 technology professionals and ask your questions.

    Join & Ask a Question

    Need Help in Real-Time?

    Connect with top rated Experts

    17 Experts available now in Live!

    Get 1:1 Help Now