Hello,
I manage a mailbox where employees submit leads from an intranet form that is filled out then submitted via email. I get about 10 to 20 emails a day and need them all processed when I open the workbook and import them. I've searched all over and cannot find anything that will work for what I need.

I found the code below and it works well for the header info. but puts all the body info into one cell. I need it to put each line of the body into a new column and I only need the "Sender" from the header.

The body of the email contains the info. from the form. I need each line from the form in separate columns. I need the info after the colon of each line and some may be left blank. The column headers are below and I don't really need every line. I have noted the lines I don't need, but listed all in case it affects the code. I'm including a snapshot of the email body.

Associate Name: '--not needed
Associate Title: '--not needed
Associate ID:
Associate Branch: '--not needed
Associate Phone #: '--not needed
Email Address:
Company/Customer:
Customer Address:
Customer City/State:
Site #:
Contact Name:
Contact Title:
Contact Email:
Contact Phone:
Lead Location:
Product Services:
Additonal Comments:


Outlook_Import.jpg

Sub Download_Headers()
    'Add Tools->References->"Microsoft Outlook nn.n Object Library"
    'nn.n varies as per our Outlook Installation
    Dim Folder As Outlook.MAPIFolder
    Dim sFolders As Outlook.MAPIFolder
    Dim iRow As Integer, oRow As Integer
    Dim MailBoxName As String
    Dim Pst_Folder_Name  As String
    
    'Mailbox or PST Main Folder Name (As how it is displayed in your Outlook Session)
      MailBoxName = "Leads"
 
    'Mailbox Folder or PST Folder Name (As how it is displayed in your Outlook Session)
    Pst_Folder_Name = "1New Leads"
 
    'To directly a Folder at a high level
    'Set Folder = Outlook.Session.Folders(MailBoxName).Folders(Pst_Folder_Name)
    
    'To access a main folder or a subfolder (level-1)
    For Each Folder In Outlook.Session.Folders(MailBoxName).Folders
        If VBA.UCase(Folder.Name) = VBA.UCase(Pst_Folder_Name) Then GoTo Label_Folder_Found
        For Each sFolders In Folder.Folders
            If VBA.UCase(sFolders.Name) = VBA.UCase(Pst_Folder_Name) Then
                Set Folder = sFolders
                GoTo Label_Folder_Found
            End If
        Next sFolders
    Next Folder
 
Label_Folder_Found:
     If Folder.Name = "" Then
        MsgBox "Invalid Data in Input"
        GoTo End_Lbl1:
    End If
 
    'Read Through each Mail and export the details to Excel for Email Archival
    ThisWorkbook.Sheets(1).Activate
    Folder.Items.Sort "Received"
    
    'Insert Column Headers
    ThisWorkbook.Sheets(1).Cells(1, 1) = "Sender"
 '   ThisWorkbook.Sheets(1).Cells(1, 2) = "Subject"
 '   ThisWorkbook.Sheets(1).Cells(1, 3) = "Date"
 '   ThisWorkbook.Sheets(1).Cells(1, 4) = "Size"
 '   ThisWorkbook.Sheets(1).Cells(1, 3) = "EmailID"
    ThisWorkbook.Sheets(1).Cells(1, 6) = "Body"
    
    'Export eMail Data from PST Folder
    oRow = 1
    For iRow = 1 To Folder.Items.Count
        'If condition to import mails received in last 60 days
        'To import all emails, comment or remove this IF condition
        If VBA.DateValue(VBA.Now) - VBA.DateValue(Folder.Items.Item(iRow).ReceivedTime) <= 60 Then
           oRow = oRow + 1
           ThisWorkbook.Sheets(1).Cells(oRow, 1).Select
           ThisWorkbook.Sheets(1).Cells(oRow, 1) = Folder.Items.Item(iRow).SenderName
'          ThisWorkbook.Sheets(1).Cells(oRow, 2) = Folder.Items.Item(iRow).Subject
'           ThisWorkbook.Sheets(1).Cells(oRow, 3) = Folder.Items.Item(iRow).ReceivedTime
'           ThisWorkbook.Sheets(1).Cells(oRow, 4) = Folder.Items.Item(iRow).Size
'           ThisWorkbook.Sheets(1).Cells(oRow, 5) = Folder.Items.Item(iRow).SenderEmailAddress
           ThisWorkbook.Sheets(1).Cells(oRow, 6) = Folder.Items.Item(iRow).Body
        End If
    Next iRow
   
    Set Folder = Nothing
    Set sFolders = Nothing
    
End_Lbl1:

End Sub