CODEWITHSUNDEEP
excelvbacsvexportexport-to-csv
Millhorn
Millhorn

Reputation: 3166

Export email data to specific fields in CSV file (or XLS file)

This is regarding Excel & Outlook 2013 -

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: [email protected]
---------------------
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: August 1, 2016
Job Type: Full-time
Salary Range: $25,000
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 [email protected].
---------------------
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 bolded areas, have to fall into the following areas:

Job Title | Company Name | Description | Contact Name | Contact Email | Zip | Salary | Start Date |

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

Whatever is not bolded, should not go to the CSV either. 

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.

    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

Upvotes: 3

Views: 2268

Answers (1)

Tim Williams
Tim Williams

Reputation: 166181

If you just do this:

Print #iFile, Replace(Msg.Body, vbCrLf, ",")

then it's going to save all of the content to the file.

What you will need to do is to first split the file on vbCrLf into an array of lines:

Dim arr
arr = Split(Msg.Body, vbCrLf)

Then you need to loop over those lines looking for the specific ones you want to extract: it would be best to place that into a function which you can call from your main code:

Untested:

Function LineContent(arr, txtHeader) as String
    Dim rv as string, i as long
    for i=lbound(arr) to ubound(arr)
        if arr(i) Like txtHeader & "*" then
            rv = trim(replace(arr(i),txtHeader,"")
            exit for
        end if
    next i

    LineContent = rv
End function

Then call that function like this:

Dim cLastName as String
cLastName = LineContent(arr, "Contact Last Name:")

Once you have all the variables you need you can append them in one line to your CSV.

Caveats: none of the values you want to extract can contain line breaks (that might be a problem for "job description"), and if any of the values could contain a comma you need to wrap them in "" before writing them to your CSV.

Upvotes: 2

Related Questions