Export Email Data to specific fields in CSV file (or XLS file)

[jlnewnam]

Hello All!

I am working on a problem where I need to...

1. Receive an email
2. Have that email automatically moved to a specific folder
3. Have any email in said folder exported into a .csv file
4. The data in that file must be placed under specific columns.

I can achieve all of the above, except #4. The script places the entire body of the email in different cells depending on breakpoints.

Here's a copy of the email I need to export:
********************************************
Area of Interest: Post a Job
Type of Job: Full-time
Campus Location: Montgomery
---------------------
Contact Information:

Title: Manager
Contact Last Name: Wilson
Contact First Name: Allison
Address: 3424 Peachtree Rd NE
City: Atlanta
State: Georgia
Zip: 30326
Phone: 4042669876
Email: specialtyma@pyapc.com
---------------------
Company Information:

Company Name: Pershing, Yoakley & Associates
Company Phone: 4042669876
Company Fax Number:
Company Website:
Type Of Business:
---------------------
Job Details:

Job Title: Medical Assistant
Start Date:
Job Type: Full-time
Salary Range: to
Referral Source:
---------------------
Job Description:
A specialty practice in Montgomery, AL seeks a Medical Assistant. Prior experience in a medical practice is preferred. Candidates must have great interpersonal and customer service skills, and must be self-starters and multi-taskers – assisting physician with examination and treatment of patient and maintenance of clinical equipment.

Interested candidates should submit their resume to specialtyma@pyapc.com.
---------------------
Application Process:

---------------------
Hiring Process:

Phone Interview: Yes
Background Check: Yes
Reference Check: Yes
Credit Check: No
Technical Test: No
Personality Test: No
Physical Exam: No
Driving Records: No
Other: No
---------------------
Requested way to receive resumes:

Fax: No
Mail: No
Email: Yes
Apply in person: No
Apply online: No
---------------------
Additional Requests:

********************************************

The above areas, highlighted in red, have to fall into the following areas:

Constituent_ID

Job Title

Company Name

Category Name

Description

Contact Name

Contact Email

Location

Salary

Start Date

End Date

<tbody>
</tbody>

Here is what I have so far (referring to #'s 1-3 above)... which I've placed in ThisOutlookSession of Outlook.

Option Explicit 
Private WithEvents Items As Outlook.Items
 
Private Sub Application_Startup()
     
    Dim olApp As Outlook.Application
    Dim objNS As Outlook.NameSpace
    Set olApp = Outlook.Application
    Set objNS = olApp.GetNamespace("MAPI")
     
     '// The INCOMING JOBS folder must be a folder of the INBOX. You didn't specify, so
    
    Set Items = objNS.GetDefaultFolder(olFolderInbox).Folders("Incoming Jobs").Items
     
End Sub
Private Sub Items_ItemAdd(ByVal item As Object)
     
    On Error GoTo ErrorHandler
     
    Dim Msg As Outlook.MailItem
     
    Dim iFile As Integer
     
    If TypeName(item) = "MailItem" Then
         


        Set Msg = item
         
        iFile = FreeFile
        Open "C:\Temp\INCOMING_JOBS.CSV" For Append As #iFile
         
        Print #iFile, Replace(Msg.Body, vbCrLf, ",")
        Close #iFile
         
    End If
     
ExitPoint:
     
    Exit Sub
     
ErrorHandler:
     
    MsgBox Err.Number & " - " & Err.Description
    Resume ExitPoint
     
     '// Debug only
    Resume
     
End Sub

Can someone help me with this?

 

[jlnewnam]

I should note that all the un-highlighted information in the sample email does not need to come into the CSV file.

 

[John_w]

Try something like this. The code doesn't process all the fields - just enough to give you the general idea.

    Dim lines As Variant, i As Long, n As Long
    Dim csv(1 To 11) As String, field As Variant
    
    Set Msg = Item

    lines = Split(Msg.Body, vbCrLf)
    
    For i = 0 To UBound(lines)
    
        field = Split(lines(i), "Job Title:")
        If UBound(field) = 1 Then csv(2) = Trim(field(1))
        
        field = Split(lines(i), "Company Name:")
        If UBound(field) = 1 Then csv(3) = Trim(field(1))
        
        If InStr(lines(i), "Job Description:") > 0 Then
            csv(5) = ""
            While lines(i) <> ""
                csv(5) = csv(5) & lines(i)
                i = i + 1
            Wend
        End If

        'Process other fields similarly
        
    Next
              
    iFile = FreeFile
    Open "C:\Temp\INCOMING_JOBS.CSV" For Append As #iFile
    Print #iFile, Join(csv, ",")
    Close #iFile

 

[jlnewnam]

Hmm... It's not working. How are you considering I place this in my current set up?

 

[John_w]

It replaces:

        Set Msg = item
         
        iFile = FreeFile
        Open "C:\Temp\INCOMING_JOBS.CSV" For Append As #iFile
         
        Print #iFile, Replace(Msg.Body, vbCrLf, ",")
        Close #iFile

Put a breakpoint (F9 key) on the Set Msg line, then step through the code line by line by pressing the F8 key.

As I said, it's not the complete code. Make sure the lines array returned by Split(Msg.Body...) is correct - code assumes each line is terminated by vbCrLf.

 

[jlnewnam]

I've gotten the majority of this script to work. All the fields pull over to the CSV. The only problem I'm having is I need the commas to be included and not break the import. When I pull in anything that comes through the form with a comma, it sends everything after the comma into the next field and interrupts the import. This especially happens when importing the job description, which obviously delivers a lot of commas.

Any advice on this?

 

[John_w]

When I pull in anything that comes through the form with a comma, it sends everything after the comma into the next field and interrupts the import.

Surround each csv field with quotes, like this:

        field = Split(lines(i), "Job Title:")
        If UBound(field) = 1 Then csv(2) = Chr(34) & Trim(field(1)) & Chr(34)

and similarly for the other fields.