Export from Outlook and Append to Excel worksheet

I have a need to take data that is submitted in as an email, and to take the data and append it to an Excel workbook. The email always has the subject line Enquiry form details

I am unable to change or specify the format of the email, which is recieved in Outlook (2003) and looks like this: (everything between the dashes)

------
The following details were submitted:

First Name: Ann
Surname: Other
Email: atest1@yahoo.co.uk
Address: 1415 Long Street
Address 2: Suberbia
Town: Metropolis
County: County Name
Postcode: AA00 B99
Telephone: 00000 000000
Age range: 25-34
Interests: Shopping Break, Tour of Cornwall, Theatre Break

------

I need to automate the appending of this data to an excel(2003) workbook, the workbook column headings DO correspond to the field names in the email, but the the Interests field may include up to 5 entries (seperated by commas) which need to be recorded in seperate columns - look at the attached XL file and you will see what I mean.

Can anyone help with this?

Perhaps a rule that can run a macro ?
or some other automated or semi-automated way to add data from emails to the workbook - a sample of the workbook is attached.
Responses.xls
LVL 70
Brian PiercePhotographerAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

StealthyDevCommented:
Hi,

Can you please send us your automation, so that we can add the comma separated part.

Regards.

0
Brian PiercePhotographerAuthor Commented:
I'm not sure what you mean,
 the email is recieved in the following format (everything between the dashes)

------
The following details were submitted:

First Name: Ann
Surname: Other
Email: atest1@yahoo.co.uk
Address: 1415 Long Street
Address 2: Suberbia
Town: Metropolis
County: County Name
Postcode: AA00 B99
Telephone: 00000 000000
Age range: 25-34
Interests: Shopping Break, Tour of Cornwall, Theatre Break

------

0
DonkeyOteCommented:
Yes the code would certainly help...

In "theory" you can take the field string and populate a Variant Array c/o a Split call with known delimiter (eg comma space)

vInterests = Split(value,", ")

You can then resize the cell into which you intend to paste (L?) per the UBound of vInterests (+1) and paste the array, eg:

Cells(n,"L").Resize(,UBound(vInterests)+1).Value = vInterests
0
Ultimate Tool Kit for Technology Solution Provider

Broken down into practical pointers and step-by-step instructions, the IT Service Excellence Tool Kit delivers expert advice for technology solution providers. Get your free copy now.

Brian PiercePhotographerAuthor Commented:
sorry DonkeyOte, that means nothing to me
0
StealthyDevCommented:
Hi KCTS, do you want a fresh automation? or you have anything developed previously?
0
Brian PiercePhotographerAuthor Commented:
I have nothing, I'm starting from scratch
0
StealthyDevCommented:
I can give you an idea.

Use visual basic (may be .net) to read your mails.
Use GetPrivateProfileString (read ini) function to read the mail content. you need to have a mail with "=" sign instead of ":" or simply replace ":" with "=" after reading the mail.

Then use excel-vb integration to create a new spreadsheet and put all your data in it.

For the last point, use split string concept to split with respect to comma separated values.

For reading mails:
http://www.bigresource.com/VB-Reading-Outlook-email-using-visual-basic-E0IkE48Jm3.html

Working with Excel-VB:
http://bytes.com/topic/c-sharp/answers/505920-working-excel

Regards.

0
Brian PiercePhotographerAuthor Commented:
I'm not a scripting expert, I was hoping for something a little more concrete.

As I said, I dont want to create a NEW sheet, I need to append to the existing one
The solution does not need to be fully automated, I dont mind selecting the emails then caling a function, bu I don't know where to start.
0
Patrick MatthewsCommented:
KCTS,

I dabble in Outlook; for a real Expert you want someone like chris_bottomley or BlueDevilFan. This code, however, appears to be working when applied against a single message in the ActiveInspector. One of those guys can help you expand it if need be.

A portion of it uses Regular Expressions, as covered in my article http://www.experts-exchange.com/articles/Programming/Languages/Visual_Basic/Using-Regular-Expressions-in-Visual-Basic-for-Applications-and-Visual-Basic-6.html

Patrick


Sub GetTheData() 
     
    Dim TheMessage As String 
    Dim arr(1 To 12, 1 To 2) As Variant 
    Dim Counter As Long 
    Dim TheLine As String 
    Dim xlApp As Object 
    Dim xlWb As Object 
    Dim xlWs As Object 
    Dim NextR As Long 
    Dim ColNum As Long 
    Dim ValueStr As String 
    Dim Interests As Variant 
     
    ' On second dimension, 1=headings from message, 2=headings in Excel file 
     
    arr(1, 1) = "First Name": arr(1, 2) = "First Name" 
    arr(2, 1) = "Surname": arr(2, 2) = "Surname" 
    arr(3, 1) = "Email": arr(3, 2) = "Email" 
    arr(4, 1) = "Address": arr(4, 2) = "Address1" 
    arr(5, 1) = "Address 2": arr(5, 2) = "Address2" 
    arr(6, 1) = "Town": arr(6, 2) = "Town" 
    arr(7, 1) = "County": arr(7, 2) = "County" 
    arr(8, 1) = "Postcode": arr(8, 2) = "Postcode" 
    arr(9, 1) = "Telephone": arr(9, 2) = "Telephone" 
    arr(10, 1) = "Age range": arr(10, 2) = "Age Range" 
    arr(11, 1) = "Interests": arr(11, 2) = "Interests" 
     
    TheMessage = ActiveInspector.CurrentItem.Body 
     
    Set xlApp = CreateObject("Excel.Application") 
    Set xlWb = xlApp.Workbooks.Open("C:\folder\subfolder\Q_25831986.xls") 'change as needed
    Set xlWs = xlWb.Worksheets(1) 
     
    With xlWs 
        NextR = .Cells(.Rows.Count, "a").End(-4162).Row + 1 '-4162 = xlUp 
        For Counter = 1 To 11 
            TheLine = RegExpFind(TheMessage, arr(Counter, 1) & ":[^\n]*\n", 1, False) 
            If TheLine <> "" Then 
                ValueStr = Split(TheLine, ":")(1) 
                ColNum = xlApp.Match(arr(Counter, 2), .[1:1], 0) 
                If Counter < 11 Then 
                    .Cells(NextR, ColNum) = Trim(ValueStr) 
                Else 
                    Interests = Split(Replace(ValueStr, ", ", ","), ",") 
                    .Cells(NextR, ColNum).resize(1, UBound(Interests) + 1).Value = Interests 
                End If 
                .Cells(NextR, "a") = Date 
            End If 
        Next 
    End With 
     
    xlWb.Save 
    xlWb.Close 
    Set xlWs = Nothing 
    Set xlWb = Nothing 
    xlApp.Quit 
    Set xlApp = Nothing 
     
    MsgBox "Done" 
     
End Sub 
 
Function RegExpFind(LookIn As String, PatternStr As String, Optional Pos, _ 
    Optional MatchCase As Boolean = True, Optional ReturnType As Long = 0, _ 
    Optional MultiLine As Boolean = False) 
     
    ' Function written by Patrick G. Matthews.  You may use and distribute this code freely, 
    ' as long as you properly credit and attribute authorship and the URL of where you 
    ' found the code 
     
    ' For more info, please see: 
    ' http://www.experts-exchange.com/articles/Programming/Languages/Visual_Basic/Using-Regular-Expressions-in-Visual-Basic-for-Applications-and-Visual-Basic-6.html 
     
    ' This function relies on the VBScript version of Regular Expressions, and thus some of 
    ' the functionality available in Perl and/or .Net may not be available.  The full extent 
    ' of what functionality will be available on any given computer is based on which version 
    ' of the VBScript runtime is installed on that computer 
     
    ' This function uses Regular Expressions to parse a string (LookIn), and return matches to a 
    ' pattern (PatternStr).  Use Pos to indicate which match you want: 
    ' Pos omitted               : function returns a zero-based array of all matches 
    ' Pos = 1                   : the first match 
    ' Pos = 2                   : the second match 
    ' Pos = <positive integer>  : the Nth match 
    ' Pos = 0                   : the last match 
    ' Pos = -1                  : the last match 
    ' Pos = -2                  : the 2nd to last match 
    ' Pos = <negative integer>  : the Nth to last match 
    ' If Pos is non-numeric, or if the absolute value of Pos is greater than the number of 
    ' matches, the function returns an empty string.  If no match is found, the function returns 
    ' an empty string.  (Earlier versions of this code used zero for the last match; this is 
    ' retained for backward compatibility) 
     
    ' If MatchCase is omitted or True (default for RegExp) then the Pattern must match case (and 
    ' thus you may have to use [a-zA-Z] instead of just [a-z] or [A-Z]). 
     
    ' ReturnType indicates what information you want to return: 
    ' ReturnType = 0            : the matched values 
    ' ReturnType = 1            : the starting character positions for the matched values 
    ' ReturnType = 2            : the lengths of the matched values 
     
    ' If you use this function in Excel, you can use range references for any of the arguments. 
    ' If you use this in Excel and return the full array, make sure to set up the formula as an 
    ' array formula.  If you need the array formula to go down a column, use TRANSPOSE() 
     
    ' Note: RegExp counts the character positions for the Match.FirstIndex property as starting 
    ' at zero.  Since VB6 and VBA has strings starting at position 1, I have added one to make 
    ' the character positions conform to VBA/VB6 expectations 
     
    ' Normally as an object variable I would set the RegX variable to Nothing; however, in cases 
    ' where a large number of calls to this function are made, making RegX a static variable that 
    ' preserves its state in between calls significantly improves performance 
     
    Static RegX As Object 
    Dim TheMatches As Object 
    Dim Answer() 
    Dim Counter As Long 
     
    ' Evaluate Pos.  If it is there, it must be numeric and converted to Long 
     
    If Not IsMissing(Pos) Then 
        If Not IsNumeric(Pos) Then 
            RegExpFind = "" 
            Exit Function 
        Else 
            Pos = CLng(Pos) 
        End If 
    End If 
     
    ' Evaluate ReturnType 
     
    If ReturnType < 0 Or ReturnType > 2 Then 
        RegExpFind = "" 
        Exit Function 
    End If 
     
    ' Create instance of RegExp object if needed, and set properties 
     
    If RegX Is Nothing Then Set RegX = CreateObject("VBScript.RegExp") 
    With RegX 
        .Pattern = PatternStr 
        .Global = True 
        .IgnoreCase = Not MatchCase 
        .MultiLine = MultiLine 
    End With 
         
    ' Test to see if there are any matches 
     
    If RegX.Test(LookIn) Then 
         
        ' Run RegExp to get the matches, which are returned as a zero-based collection 
         
        Set TheMatches = RegX.Execute(LookIn) 
         
        ' Test to see if Pos is negative, which indicates the user wants the Nth to last 
        ' match.  If it is, then based on the number of matches convert Pos to a positive 
        ' number, or zero for the last match 
         
        If Not IsMissing(Pos) Then 
            If Pos < 0 Then 
                If Pos = -1 Then 
                    Pos = 0 
                Else 
                     
                    ' If Abs(Pos) > number of matches, then the Nth to last match does not 
                    ' exist.  Return a zero-length string 
                     
                    If Abs(Pos) <= TheMatches.Count Then 
                        Pos = TheMatches.Count + Pos + 1 
                    Else 
                        RegExpFind = "" 
                        GoTo Cleanup 
                    End If 
                End If 
            End If 
        End If 
         
        ' If Pos is missing, user wants array of all matches.  Build it and assign it as the 
        ' function's return value 
         
        If IsMissing(Pos) Then 
            ReDim Answer(0 To TheMatches.Count - 1) 
            For Counter = 0 To UBound(Answer) 
                Select Case ReturnType 
                    Case 0: Answer(Counter) = TheMatches(Counter) 
                    Case 1: Answer(Counter) = TheMatches(Counter).FirstIndex + 1 
                    Case 2: Answer(Counter) = TheMatches(Counter).Length 
                End Select 
            Next 
            RegExpFind = Answer 
         
        ' User wanted the Nth match (or last match, if Pos = 0).  Get the Nth value, if possible 
         
        Else 
            Select Case Pos 
                Case 0                          ' Last match 
                    Select Case ReturnType 
                        Case 0: RegExpFind = TheMatches(TheMatches.Count - 1) 
                        Case 1: RegExpFind = TheMatches(TheMatches.Count - 1).FirstIndex + 1 
                        Case 2: RegExpFind = TheMatches(TheMatches.Count - 1).Length 
                    End Select 
                Case 1 To TheMatches.Count      ' Nth match 
                    Select Case ReturnType 
                        Case 0: RegExpFind = TheMatches(Pos - 1) 
                        Case 1: RegExpFind = TheMatches(Pos - 1).FirstIndex + 1 
                        Case 2: RegExpFind = TheMatches(Pos - 1).Length 
                    End Select 
                Case Else                       ' Invalid item number 
                    RegExpFind = "" 
            End Select 
        End If 
     
    ' If there are no matches, return empty string 
     
    Else 
        RegExpFind = "" 
    End If 
     
Cleanup: 
    ' Release object variables 
     
    Set TheMatches = Nothing 
     
End Function

Open in new window

0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Brian PiercePhotographerAuthor Commented:
Many thanks - I'll give it a try and report back
0
Brian PiercePhotographerAuthor Commented:
Ok I've just tried to impliment this and I've run into a couple of issues
Firstly the macro fails with
Sub or Function Not defined: RegExpFind

secondly,  assuming it can be made to work it is possible to be able to right click on an emal in the inbox and invoke the macro from there ?
0
Patrick MatthewsCommented:
>>Firstly the macro fails with
>>Sub or Function Not defined: RegExpFind

Are you sure you pasted in all of the code from my previous comment?  That code include the function RegExpFind.

In any event, the code works when I run it on my side :)

>>secondly,  assuming it can be made to work it is possible to be able to right click on an emal in the inbox and
>>invoke the macro from there ?

Yes, this is possible, but I do not know how to do it.  I suggest that you first determine if my code works on a single message in the ActiveInspector, and then use Request Attention to ask the Mods to send alerts out so we can try to add the multi-message functionality you are looking for.
0
Brian PiercePhotographerAuthor Commented:
OK, we're getting somewhere near now - its amazing how much better it works when I copy the complete code ! :-)

Just a few additional tweeks required to make it perfect

At the moment I have to open the message, then run the macro.

Ideally I would like to be able to right click on the message in the inbox (without opening it), and then select the macro from the right click menu.

Can anyone tell me how to do this ?
0
StealthyDevCommented:
KCTS, sorry to interrupt your question.

Hi matthewspatrick, i am not aware of how to work with outlook macros, can you guide me how to? I have knowledge in excel-vba.

Thanks in advance.
0
Chris BottomleySoftware Quality Lead EngineerCommented:
>>> right click on the message in the inbox

Which version of outlook?

Chris
0
Chris BottomleySoftware Quality Lead EngineerCommented:
senthurpandian:

Try Sue Moshers books on outlook programming which are amazing, the web site she used to run http://www.outlookcode.com/ but most imortantly the real world questions and answers of a site like this

Chris
0
StealthyDevCommented:
Thanks chris, i will look at it.

Cheers.
0
Chris BottomleySoftware Quality Lead EngineerCommented:
KCTS:

>>> right click on the message in the inbox

Which version of outlook, the complexity of the solution depends on teh version so to try and provide a tailored solution the version is important.  FYI, I know nothing of 2010 but assume it is largely the same as 2007 and the choices therefore split between pre 2007 and 2007 or later.

Chris
0
Brian PiercePhotographerAuthor Commented:
This is outlook 2003 (at the moment), it would be good to know how to adapt it for 2007 a well though
0
Chris BottomleySoftware Quality Lead EngineerCommented:
The following for 2003 is derived from the Sue Mosher, (historically) site OutlookCode.  The code can all reside in thisOutlookSession and then simply calls your action code, GetTheData

I have bracketed each block with context string so that the related code is easier to pick out.  As it stands the code should be there though it it does no error checking on the selection that can however be added.  I am in fact on a 2007 pc so haven't tested this variant but it is common data I have used before so ought to have been adapted correctly.  If not let me know and I will try and find a 2003 machine to correct it on.

Chris
'### Context
Private WithEvents ActiveExplorerCBars As CommandBars Private WithEvents ContextButton As CommandBarButton 'A flag, so we don't respond to our own changes in OnUpdate Private IgnoreCommandbarsChanges As Boolean '### Context

Private Sub Application_Startup()
'### Context
    Set ActiveExplorerCBars = ActiveExplorer.CommandBars '### Context End Sub


'### Context
Private Sub ContextButton_Click(ByVal Ctrl As Office.CommandBarButton, CancelDefault As Boolean)
    GetTheData
End Sub

'This fires when the user right-clicks a contact, and also for a lot of other things!
Private Sub ActiveExplorerCBars_OnUpdate()
    Dim bar As CommandBar

    If IgnoreCommandbarsChanges Then Exit Sub

    'Try for the context menu
    On Error Resume Next
    Set bar = ActiveExplorerCBars.item("Context Menu")
    On Error GoTo 0

    If Not bar Is Nothing Then
        AddContextButton bar
    End If
End Sub

Private Sub AddContextButton(ContextMenu As CommandBar)
    Dim b As CommandBarButton
    Dim Control As CommandBarControl

    'User cannot play with the Context Menu, so we know there is at most
    'only one copy of the control there
    Set Control =
ContextMenu.findControl(Type:=MsoControlType.msoControlButton,
Tag:="UpdateExcel")

    If Control Is Nothing Then

        'Unprotect context menu
        ChangingBar ContextMenu, Restore:=False

        'Create the control
        Set Control = ContextMenu.Controls.Add(Type:=msoControlButton)

        'Set up control
        Control.Tag = "UpdateExcel"
        Control.Caption = "Send All"
        Control.Priority = 1
        Control.Visible = True

        'Reprotect context menu
        ChangingBar ContextMenu, Restore:=True

        'Hook the Click event
        Set ContextButton = Control

    Else
        'Note that Outlook has a bad habbit of changing our Context Menu buttons
        'to be priority dropped.
        Control.Priority = 1
    End If

End Sub

'Called once to prepare for changes to the command bar, then again with 'Restore = true once changes are complete.
Private Sub ChangingBar(bar As CommandBar, Restore As Boolean)

  Static oldProtectFromCustomize, oldIgnore As Boolean

  If Restore Then

    'Restore the Ignore Changes flag
    IgnoreCommandbarsChanges = oldIgnore

    'Restore the protect-against-customization bit
    If oldProtectFromCustomize Then bar.Protection = _
      bar.Protection And msoBarNoCustomize

  Else

    'Store the old Ignore Changes flag
    oldIgnore = IgnoreCommandbarsChanges
    IgnoreCommandbarsChanges = True

    'Store old protect-against-customization bit setting then clear
    'CAUTION: Be careful not to alter the property if there is no need,
    'as changing the Protection will cause any visible CommandBarPopup
    'to disappear unless it is the popup we are altering.
    oldProtectFromCustomize = bar.Protection And msoBarNoCustomize
    If oldProtectFromCustomize Then bar.Protection = bar.Protection _
      And Not msoBarNoCustomize

  End If

End Sub
'### Context

Open in new window

0
Chris BottomleySoftware Quality Lead EngineerCommented:
Once that is there and working I will happily post the equivalent for 2007 but it is significantly different ... and tons easier.

Chris
0
Brian PiercePhotographerAuthor Commented:
Thanks for this - I will test it during th next couple of days and get back to you ASAP
0
Chris BottomleySoftware Quality Lead EngineerCommented:
Overlooked an update to the legend for the context menu item ... applied the correction below.  Functionally nothing is changed it is just the button text

Chris
'### Context
Private WithEvents ActiveExplorerCBars As CommandBars Private WithEvents ContextButton As CommandBarButton 'A flag, so we don't respond to our own changes in OnUpdate Private IgnoreCommandbarsChanges As Boolean 
'### Context

Private Sub Application_Startup()
'### Context
    Set ActiveExplorerCBars = ActiveExplorer.CommandBars 
'### Context End Sub


'### Context
Private Sub ContextButton_Click(ByVal Ctrl As Office.CommandBarButton, CancelDefault As Boolean)
    GetTheData
End Sub

'This fires when the user right-clicks a contact, and also for a lot of other things!
Private Sub ActiveExplorerCBars_OnUpdate()
    Dim bar As CommandBar

    If IgnoreCommandbarsChanges Then Exit Sub

    'Try for the context menu
    On Error Resume Next
    Set bar = ActiveExplorerCBars.item("Context Menu")
    On Error GoTo 0

    If Not bar Is Nothing Then
        AddContextButton bar
    End If
End Sub

Private Sub AddContextButton(ContextMenu As CommandBar)
    Dim b As CommandBarButton
    Dim Control As CommandBarControl

    'User cannot play with the Context Menu, so we know there is at most
    'only one copy of the control there
    Set Control =
ContextMenu.findControl(Type:=MsoControlType.msoControlButton,
Tag:="UpdateExcel")

    If Control Is Nothing Then

        'Unprotect context menu
        ChangingBar ContextMenu, Restore:=False

        'Create the control
        Set Control = ContextMenu.Controls.Add(Type:=msoControlButton)

        'Set up control
        Control.Tag = "UpdateExcel"
        Control.Caption = "Update Excel"
        Control.Priority = 1
        Control.Visible = True

        'Reprotect context menu
        ChangingBar ContextMenu, Restore:=True

        'Hook the Click event
        Set ContextButton = Control

    Else
        'Note that Outlook has a bad habbit of changing our Context Menu buttons
        'to be priority dropped.
        Control.Priority = 1
    End If

End Sub

'Called once to prepare for changes to the command bar, then again with 'Restore = true once changes are complete.
Private Sub ChangingBar(bar As CommandBar, Restore As Boolean)

  Static oldProtectFromCustomize, oldIgnore As Boolean

  If Restore Then

    'Restore the Ignore Changes flag
    IgnoreCommandbarsChanges = oldIgnore

    'Restore the protect-against-customization bit
    If oldProtectFromCustomize Then bar.Protection = _
      bar.Protection And msoBarNoCustomize

  Else

    'Store the old Ignore Changes flag
    oldIgnore = IgnoreCommandbarsChanges
    IgnoreCommandbarsChanges = True

    'Store old protect-against-customization bit setting then clear
    'CAUTION: Be careful not to alter the property if there is no need,
    'as changing the Protection will cause any visible CommandBarPopup
    'to disappear unless it is the popup we are altering.
    oldProtectFromCustomize = bar.Protection And msoBarNoCustomize
    If oldProtectFromCustomize Then bar.Protection = bar.Protection _
      And Not msoBarNoCustomize

  End If

End Sub
'### Context

Open in new window

0
Brian PiercePhotographerAuthor Commented:
Almost there - except that I have to have the email open for it to work, if I just right click the message in the inbox and select Update Excel, the GetTheData functioin fails on the line that reads

    TheMessage = ActiveInspector.CurrentItem.Body
with
Runtime error 91
Object variable or Block with variable not set
0
David LeeCommented:
Change that line from

TheMessage = ActiveInspector.CurrentItem.Body

to

TheMessage = Application.ActiveExplorer.Selection(1)
0
Chris BottomleySoftware Quality Lead EngineerCommented:
David

Thanks for that.

Chris
0
David LeeCommented:
You're welcome, Chris.  
0
Brian PiercePhotographerAuthor Commented:
I really wish I could give more points for all the help that you guys have given me. You have all been fantastic :-)
0
Brian PiercePhotographerAuthor Commented:
Opps - sorry guys - I thought it was working, but something is amis - the code seems to run and complete (and says Done at then the end) but nothing seems to be added to the excel sheet - I'll post the follow-up as a new question
0
Patrick MatthewsCommented:
KCTS,

Glad to help!

Chris and BDF: always a pleasure working with you gents :)

Cheers,

Patrick
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Outlook

From novice to tech pro — start learning today.

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.