VBA to return values from a cell and create new columns

[Access Beginner]

Hi All,

I have found some code on the interent which will export all emails from a folder in Outlook into excel.

The issue is that it exports the most important part of the email into one cell. The example below is placed in cell F2. Cell F1 has the heading of "Body".What I'd like if possible, is for a piece of code to be created which will look at cell F2 and create a column for each the field below eg. "Name" in cell G1 as the header and in G2 the value of "Joe", then in H1 create a header called "contactId" and in H2 the value of "xxxxxx" . Cell F3 is in the same format and will have the same number of items (From: Name: etc). So the value of "Name" in cell F3 would be place in G3 and so on.

Wiki Data Request: 
From: Joe
Name: Joe
contactId: xxxxxx
Contact Number: 99999999
EmailAddress: joe.blow@blahblah.com
Master Program:Test
Division: Test
Branch: Test 
Zone: test
Level: Test
Due Date: 2/05/2025
Internal or External: Internal
Request Details: Text text text etc etc
Purpose: Text text text etc etc

Hoping someone will be able to assist

Using Excel 2013

Cheers
Haydn

 

[Access Beginner]

bump for one more try

 

[FormR]

If I understand correctly and the data in F2 is separated by carriage returns.

G1: copied across

=TRIM(LEFT(SUBSTITUTE(TRIM(MID(SUBSTITUTE($F2,CHAR(10),REPT(" ",99)),COLUMNS($G1:G1)*99-98,99)),":",REPT(" ",255)),255))

G2: copied across

=TRIM(MID(SUBSTITUTE(TRIM(MID(SUBSTITUTE($F2,CHAR(10),REPT(" ",99)),COLUMNS($G2:G2)*99-98,99)),":",REPT(" ",255)),255,255))

Alternatively, you could post the post VBA code you are using and someone may be able to amend it to output the results directly as want them.

 

[Access Beginner]

Thanks FormR,

The formula solution works great and happy to have it as a formula solution

Cheers
Haydn

 

[Access Beginner]

If I understand correctly and the data in F2 is separated by carriage returns.

G1: copied across

=TRIM(LEFT(SUBSTITUTE(TRIM(MID(SUBSTITUTE($F2,CHAR(10),REPT(" ",99)),COLUMNS($G1:G1)*99-98,99)),":",REPT(" ",255)),255))

G2: copied across

=TRIM(MID(SUBSTITUTE(TRIM(MID(SUBSTITUTE($F2,CHAR(10),REPT(" ",99)),COLUMNS($G2:G2)*99-98,99)),":",REPT(" ",255)),255,255))

Alternatively, you could post the post VBA code you are using and someone may be able to amend it to output the results directly as want them.

Hello again,

Just found an issue for me.

For thye free text fields "Request Details:" and "Purpose:" it is truncating the values. It seems that the truncation can vary, in terms of the number of characters it truncates at

Any help is appreciated.

Cheers
Haydn

 

[FormR]

For thye free text fields "Request Details:" and "Purpose:" it is truncating the values. It seems that the truncation can vary, in terms of the number of characters it truncates at

There may well be extra carriage returns in those free text fields, its probably best to modify your macro to split the values up. If you post it someone should be able to help.

 

[Access Beginner]

Hi All,

Below is the code I found online. Can someone tweak this taking into account the above

Sub Download_Outlook_Mail_To_Excel()

    'Clear exisiting Emails
    '

    Range("A1:F1133").Select
    Selection.Clear

    'http://officetricks.com/outlook-email-download-to-excel/
    'Add Tools->References->"Microsoft Outlook nn.n Object Library"
    'nn.n varies as per our Outlook Installation
    Dim Folder As Outlook.MAPIFolder
    Dim iRow As Integer, oRow As Integer
    Dim MailBoxName As String, Pst_Folder_Name  As String
    
    'Mailbox or PST Main Folder Name (As how it is displayed in your Outlook Session)
    MailBoxName = "joo.blow@whatever.com"
 
    'Mailbox Folder or PST Folder Name (As how it is displayed in your Outlook Session)
    Pst_Folder_Name = "Data Requests" 'Sample "Inbox" or "Sent Items"
 
    Set Folder = Outlook.Session.Folders(MailBoxName).Folders(Pst_Folder_Name)
    If Folder = "" 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, 5) = "EmailID"
    ThisWorkbook.Sheets(1).Cells(1, 6) = "Body"
    
    'Insert Mail Data
    For iRow = 1 To Folder.Items.Count
        oRow = iRow + 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
    Next iRow
    MsgBox "Outlook Mails Extracted to Excel"
 
end_lbl1:
End Sub

This is the format the email comes back as, in one cell. The fornmula solution above doesn't work when there are carriages in the free text fields

Wiki Data Request: 
From: Joe
Name: Joe
contactId: xxxxxx
Contact Number: 99999999
EmailAddress: joe.blow@blahblah.com
Master Program:Test
Division: Test
Branch: Test 
Zone: test
Level: Test
Due Date: 2/05/2025
Internal or External: Internal
Request Details: Text text text etc etc
Purpose: Text text text etc etc

 

[Access Beginner]

bump