Results 1 to 7 of 7

Thread: Email to Excel

  1. #1
    Lounger Lexi's Avatar
    Join Date
    Aug 2013
    Posts
    25
    Thanks
    20
    Thanked 1 Time in 1 Post

    Email to Excel

    Greetings Loungers,
    Perhaps, someone may help me with a dilemma I am having. I have a web form that returns an email to Outlook with responses to the questions on the form. I would like to know if it is possible to have that data in the email sent to a spreadsheet to maintain a database. I notice that attachments can be added but due to the sensitivity of other employees, I cannot attach the file that I am currently updating manually. Below is a copy of some of the fields returned in the email with the values removed.

    Employee LastName=
    Employee FirstName=
    Request Date=
    Employee ID#=
    Employee SSN (last 4 digits)=
    Employee extension=
    Depatrment Head LastName=
    Depatrment Head FirstName=
    Depatrment Head ID#=
    Depatrment Head Password=
    Depatrment Head Cost Center=
    Depatrment Head Extension=

    Thank,
    Lexi

  2. #2
    Gold Lounger Maudibe's Avatar
    Join Date
    Aug 2010
    Location
    Pa, USA
    Posts
    2,639
    Thanks
    115
    Thanked 650 Times in 592 Posts

    VBA in Outlook

    Lexi,

    Welcome to the forum. If I understand you correctly, you want to send data from an email with form data to a spreadsheet, however, you did not specify if you wanted to do it from Outlook or from within Excel. I think this would be so much easier running code form Outlook to do the export. So...Here is some code that will gather info of the recipient, subject, and received date and time, as well as the data in the body of the email and then send it to a spreadsheet.

    When the code is run, you will be presented with a dialogue box to select a dedicated folder that contains the desired emails that were moved from the inbox. The code will then get the data and place it into an array variable s(n). It will then split the data (field name and field value), match up the Outlook field name with the Excel header column, and place the value. Below is a screen shot from a sample email I constructed and sent myself then ran the code to produce an upload into Excel.

    You will need to change the path and the file name in the code. Place in a standard module of the project. I am sure you will need help if you wish to pursue this. You can Private message me if you like.

    HTH,
    Maud



    email.png outlook.PNG

    Code:
    Sub FormData()
    'DECLARE VARIABLES
    Dim AppEx As Excel.Application
    Dim WkBook As Excel.Workbook
    Dim WkSheet As Excel.Worksheet
    Dim rng As Excel.Range
    Dim SheetName As String
    Dim PathName As String
    Dim excelRow As Integer
    Dim excelCol As Integer
    Dim msgOutlook As Outlook.MailItem
    Dim nmsOutlook As Outlook.NameSpace
    Dim fldOutlook As Outlook.MAPIFolder
    Dim itemOutlook As Object
    Dim s As Variant
    Dim t As Variant
    Dim LastRow As Integer
    '-----------------------------------------
    'SET VARIABLES
    SheetName = "EmailDatabase.xls"  'CHANGE TO SHEET NAME
    PathName = "C:\Users\Maudibe\Desktop\"   'CHANGE TO PATH
    SheetName = PathName & SheetName
    Debug.Print SheetName  'Select export folder
    Set nmsOutlook = Application.GetNamespace("MAPI")
    Set fldOutlook = nmsOutlook.PickFolder  'Handle potential errors with Select Folder dialog box.
    '-----------------------------------------
    'TEST CONDITIONS
    'NO FOLDER SELECTED
    If fldOutlook Is Nothing Then
    MsgBox "There are no mail messages to export", vbOKOnly, _
    "Error"
    Exit Sub
    'NO MAIL MESSAGES
    ElseIf fldOutlook.DefaultItemType <> olMailItem Then
    MsgBox "There are no mail messages to export", vbOKOnly, _
    "Error"
    Exit Sub
    'FOLDER IS EMPTY
    ElseIf fldOutlook.Items.Count = 0 Then
    MsgBox "There are no mail messages to export", vbOKOnly, _
    "Error"
    Exit Sub
    End If
    '-----------------------------------------
    'OPEN AND ACTIVATE EXCEL WORKBOOK
    Set AppEx = CreateObject("Excel.Application")
    AppEx.Workbooks.Open (SheetName)
    Set WkBook = AppEx.ActiveWorkbook
    Set WkSheet = WkBook.Sheets(1)
    WkBook.Activate
    WkSheet.Activate
    AppEx.Application.Visible = True
    'SEARCH FOR LASTROW
    For I = 3 To 10000
        If WkSheet.Cells(I, 1).Value = "" Then
            LastRow = I
            Exit For
        End If
    Next I
    '-----------------------------------------
    'COPY FIELD ITEMS IN MAIL FOLDER
    excelRow = LastRow
    For Each itemOutlook In fldOutlook.Items
    excelCol = 1
    Set msgOutlook = itemOutlook
    If msgOutlook.Subject = "Form posted from Windows Internet Explorer." Then
    'RECIPIENT
    Set rng = WkSheet.Cells(excelRow, excelCol)
    rng.Value = msgOutlook.To
    excelCol = excelCol + 1
    'rng.Value = msgOutlook.SenderEmailAddress
    'SUBJECT
    Set rng = WkSheet.Cells(excelRow, excelCol)
    rng.Value = msgOutlook.Subject
    excelCol = excelCol + 1
    'SENT DATE/TIME
    Set rng = WkSheet.Cells(excelRow, excelCol)
    rng.Value = msgOutlook.SentOn
    excelCol = excelCol + 1
    'rng.Value = msgOutlook.ReceivedTime
    'BODY
    Set rng = WkSheet.Cells(excelRow, excelCol)
    rng.Value = msgOutlook.Body
    s = Split(WkSheet.Cells(excelRow, excelCol), Chr(10))
    For I = 0 To UBound(s) - 1
        t = Split(s(I), "=")
        Select Case t(0)
            Case "Employee LastName"
                WkSheet.Cells(excelRow, 4).Value = t(1)
            Case "Employee FirstName"
                WkSheet.Cells(excelRow, 5).Value = t(1)
            Case "Request Date"
                WkSheet.Cells(excelRow, 6).Value = t(1)
            Case "Employee ID#"
                WkSheet.Cells(excelRow, 7).Value = t(1)
            Case "Employee SSN (last 4 digits)"
                WkSheet.Cells(excelRow, 8).Value = t(1)
            Case "Employee extension"
                WkSheet.Cells(excelRow, 9).Value = t(1)
            Case "Depatrment Head LastName"
                WkSheet.Cells(excelRow, 10).Value = t(1)
            Case "Depatrment Head FirstName"
                WkSheet.Cells(excelRow, 11).Value = t(1)
            Case "Depatrment Head ID#"
                WkSheet.Cells(excelRow, 12).Value = t(1)
            Case "Depatrment Head Password"
                WkSheet.Cells(excelRow, 13).Value = t(1)
            Case "Depatrment Head Cost Center"
                WkSheet.Cells(excelRow, 14).Value = t(1)
            Case "Depatrment Head Extension"
                WkSheet.Cells(excelRow, 15).Value = t(1)
         End Select
    Next I
    excelCol = excelCol + 1
    excelRow = excelRow + 1
    End If
    Next itemOutlook
    WkSheet.Cells.Columns.AutoFit
    '----------------------------------------
    'CLEANUP
    Set AppEx = Nothing
    Set WkBook = Nothing
    Set WkSheet = Nothing
    Set rng = Nothing
    Set msgOutlook = Nothing
    Set nmsOutlook = Nothing
    Set fldOutlook = Nothing
    Set itemOutlook = Nothing
    End Sub
    NOTE: I had to modify segments obtained from the web and fill in the rest. Credit will be given if I ever find those sites again

  3. The Following User Says Thank You to Maudibe For This Useful Post:

    Lexi (2013-08-21)

  4. #3
    Lounger Lexi's Avatar
    Join Date
    Aug 2013
    Posts
    25
    Thanks
    20
    Thanked 1 Time in 1 Post
    Maudibe,

    Thank you for your quick response. From your description of what the code does, you have identified exactly what I want to do. I know enough about visual basic to put you code into the module, make the changes for the path and the file name, and to run the code but that is about it. I will try this today and see how/if it works. I am guessing that the code goes in an Outlook module?

    Again, thank you for your help
    Lexi

  5. #4
    Lounger Lexi's Avatar
    Join Date
    Aug 2013
    Posts
    25
    Thanks
    20
    Thanked 1 Time in 1 Post
    Maudibe,

    I am receiving an error stating that Outlook does not understand or know the command. I have made the changes you stated. Am I doing something wrong?

    Lexi

  6. #5
    Gold Lounger Maudibe's Avatar
    Join Date
    Aug 2010
    Location
    Pa, USA
    Posts
    2,639
    Thanks
    115
    Thanked 650 Times in 592 Posts
    Lexi,

    Open the VB editor>Tools>References>Scroll until you See Microsoft Excel Object Library. If more than one exist then select the one with the higher version. Place a check mark to the left of it then click OK. You may have to restart the VB editor then try the code again. Sorry, forgot to give you that piece of vital information. I have emailed you the receiving workbook for the testing.

    Reference.png
    Last edited by Maudibe; 2013-08-21 at 18:09.

  7. The Following User Says Thank You to Maudibe For This Useful Post:

    Lexi (2013-08-22)

  8. #6
    Lounger Lexi's Avatar
    Join Date
    Aug 2013
    Posts
    25
    Thanks
    20
    Thanked 1 Time in 1 Post
    <SOLVED>

    Maudibe,

    Yes!!! that did the trick!! And thank you for your PM and email. That made it much more clear. It took me a few minutes to realize that I needed to put the emails in a dedicated folder. Once I did that, the code worked as you said. I am going to use your workbook as my database with all the conditional formatting you placed in it. You are absolutely wonderful!!

    Hope you wouldn't mind if call on you again in the future if I run into any problems.

    Lexi

  9. #7
    Gold Lounger Maudibe's Avatar
    Join Date
    Aug 2010
    Location
    Pa, USA
    Posts
    2,639
    Thanks
    115
    Thanked 650 Times in 592 Posts
    Lexi,

    Feel free to PM me anytime.

    Maud

  10. The Following User Says Thank You to Maudibe For This Useful Post:

    Lexi (2014-01-19)

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •