Loading
Ozgrid Excel Help & Best Practices Forums

Excel Training / Excel Dashboards Reports



Results 1 to 3 of 3

Thread: Exporting a body of an email to excel using VBA

  1. #1
    Join Date
    7th August 2012
    Posts
    1

    Exporting a body of an email to excel using VBA

    Hi,

    Everyday i get a email with the body in a text format which i normally do the boring Crtl A and paste special = Text. Is there a VBA code for office 2007 that can automate this process

    Details of the email:
    This email has the same title every day which i have a rule that moves it to my "personal folder/report" folder. i have seen multiple threads that look for the title but can the VBA code look for todays date and specific times (10:30am daily this report lands)
    email name = Unbilled invoice report

    What i would like is if somebody could help me with creating this VBA script so that i can click a import button (which i can create basics i know lol) in excel and excel will go to outlook and find the email and paste the contents in to A5 as text but line by line not all contents in to the cell A5. My knowledge in VBA is as limited to clicking record and being able to remove junk data thats been recorded. i am currently trying to learn more and more and would apprciate any input.

    thanks
    Jase

    Excel Video Tutorials / Excel Dashboards Reports


  2. #2
    Join Date
    29th April 2008
    Posts
    15

    Re: Exporting a body of an email to excel using VBA

    You don't have all the details of the email you are receiving but here is something I just built and wanted to put it out there as it may be useful to someone else. It's not pretty but it works for my purposes. I am using it in 2003 but it can easily be updated for greater rows in 2007.

    I have a template file with a sheet named "Import" and a basic shape called "Rectangle 1" that is assigned to run this macro.

    The emails I receive are moved to a folder and this will cycle through that folder and copy the message body to column A. The emails all contain certain tags/labels that I use to parse out the data I want. The folder isn't named in the macro it is selected by the user running the macro.

    You could start with this and change it to suit your needs by changing the formulas I have to parse out the data. I am sure there is a better way to do this but this works for me and is quick (my boss used to manually go through hundreds of these emails at the end of every month and retype them into a sheet).

    Code:
    Sub ImportOutlook()
    
    
    Application.ScreenUpdating = False
    
    
    Dim nms As Outlook.Namespace
    Dim fld As Outlook.MAPIFolder
    Dim msg As Outlook.MailItem
    
    
    Dim wkb As Excel.Workbook
    Dim wks As Excel.Worksheet
    Dim rng As Excel.Range
    
    
    Dim intRowCounter As Integer
    Dim intColumnCounter As Integer
    Dim itm As Object
    Dim sFileDate As String
    
    
    'File date
    sFileDate = Format(Now, "YYYYMMDD")
    
    
    'Delete macro button
    Sheets("Import").Activate
    ActiveSheet.Shapes("Rectangle 1").Delete
    
    
    'Select import folder
    Set nms = GetObject("", "Outlook.Application").GetNamespace("MAPI")
    Set fld = nms.PickFolder
    
    
    'Handle potential errors with Select Folder dialog box
    If fld Is Nothing Then
        
        MsgBox "There are no mail messages to export", vbOKOnly, _
        "Error"
        Application.ScreenUpdating = True
        Exit Sub
        
        ElseIf fld.DefaultItemType <> olMailItem Then
        MsgBox "There are no mail messages to export", vbOKOnly, _
        "Error"
        Application.ScreenUpdating = True
        Exit Sub
        
        ElseIf fld.Items.Count = 0 Then
        MsgBox "There are no mail messages to export", vbOKOnly, _
        "Error"
        Application.ScreenUpdating = True
        Exit Sub
    
    
    End If
    
    
    Set wkb = ActiveWorkbook
    Set wks = wkb.Sheets("Import")
    wks.Activate
    
    
    intRowCounter = 1
    
    
    'Copy field items in mail folder.
    For Each itm In fld.Items
    intColumnCounter = 1
    Set msg = itm
    intRowCounter = intRowCounter + 1
    
    
    Set rng = wks.Cells(intRowCounter, intColumnCounter)
    rng.Value = msg.Body
    intColumnCounter = intColumnCounter + 1
    
    
    Next itm
    
    
    Set wkb = Nothing
    Set wks = Nothing
    Set rng = Nothing
    Set msg = Nothing
    Set nms = Nothing
    Set fld = Nothing
    Set itm = Nothing
    
    
    'Determine data range
    LastUsedRow = Worksheets("Import").Cells.Find(What:="*", SearchOrder:=xlRows, SearchDirection:=xlPrevious, LookIn:=xlValues).Row
    
    
    'Parse out values
    Sheets("Import").Select
    Range("B2").Formula = "=MID(Trim(Clean(A2)),FIND(""Risk Owner:"",Trim(Clean(A2)))+13,FIND(""Counterparty:"",Trim(Clean(A2)))-FIND(""Risk Owner:"",Trim(Clean(A2)))-13)"
    Range("C2").Formula = "=MID(Trim(Clean(A2)),FIND(""Counterparty:"",Trim(Clean(A2)))+15,FIND(""Trade ID:"",Trim(Clean(A2)))-FIND(""Counterparty:"",Trim(Clean(A2)))-15)"
    Range("D2").Formula = "=MID(TRIM(CLEAN(A2)),FIND(""Trade ID:"",TRIM(CLEAN(A2)))+11,FIND(""Fee Leg ID:"",TRIM(CLEAN(A2)))-FIND(""Trade ID:"",TRIM(CLEAN(A2)))-11)"
    Range("E2").Formula = "=MID(TRIM(CLEAN(A2)),FIND(""Fee Leg ID:"",TRIM(CLEAN(A2)))+13,FIND(""Termination Method:"",TRIM(CLEAN(A2)))-FIND(""Fee Leg ID:"",TRIM(CLEAN(A2)))-13)"
    Range("F2").Formula = "=MID(TRIM(CLEAN(A2)),FIND(""Termination Method:"",TRIM(CLEAN(A2)))+21,FIND(""Termination amount:"",TRIM(CLEAN(A2)))-FIND(""Termination Method:"",TRIM(CLEAN(A2)))-21)"
    Range("G2").Formula = "=MID(TRIM(CLEAN(A2)),FIND(""Termination amount:"",TRIM(CLEAN(A2)))+21,FIND(""Expected Recovery:"",TRIM(CLEAN(A2)))-FIND(""Termination amount:"",TRIM(CLEAN(A2)))-21)"
    
    
    'Copy formulas
    Sheets("Import").Select
    Range("B2").Select
    Selection.AutoFill Destination:=Range("B2:B" & LastUsedRow), Type:=xlFillDefault
    Range("C2").Select
    Selection.AutoFill Destination:=Range("C2:C" & LastUsedRow), Type:=xlFillDefault
    Range("D2").Select
    Selection.AutoFill Destination:=Range("D2:D" & LastUsedRow), Type:=xlFillDefault
    Range("E2").Select
    Selection.AutoFill Destination:=Range("E2:E" & LastUsedRow), Type:=xlFillDefault
    Range("F2").Select
    Selection.AutoFill Destination:=Range("F2:F" & LastUsedRow), Type:=xlFillDefault
    Range("G2").Select
    Selection.AutoFill Destination:=Range("G2:G" & LastUsedRow), Type:=xlFillDefault
    
    
    'Paste values to remove formulas
    Sheets(Array("Import")).Select
    Sheets("Import").Activate
    Cells.Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    
    
    'Delete email message body
    Sheets("Import").Activate
    Columns("A:A").Select
    Selection.Delete Shift:=xlToLeft
    
    
    'Formatting
    Cells.Columns.AutoFit
    
    
    Columns("C:C").Select
    Selection.TextToColumns Destination:=Range("C1"), DataType:=xlDelimited, _
            TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
            Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
            :=Array(1, 1), TrailingMinusNumbers:=True
    
    
    Columns("D:D").Select
    Selection.TextToColumns Destination:=Range("D1"), DataType:=xlDelimited, _
            TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
            Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
            :=Array(1, 1), TrailingMinusNumbers:=True
            
    Columns("F:F").Select
    Selection.TextToColumns Destination:=Range("F1"), DataType:=xlDelimited, _
            TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
            Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
            :=Array(1, 1), TrailingMinusNumbers:=True
    
    
    Columns("F:F").Select
    Selection.Style = "Currency"
    
    
    Application.GoTo Sheets("Import").Range("A1"), True
    
    
    Application.ScreenUpdating = True
    
    
    'Save As
    ActiveWorkbook.SaveAs Filename:=("C:\WINDOWS\Temp" & "\OutlookImport_" & sFileDate & ".xls"), FileFormat:=xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
    
    
    Exit Sub
    
    
    ErrHandler:  If Err.Number = 1004 Then
    MsgBox strSheet & " doesn't exist", vbOKOnly, _
    "Error"
    
    
    Else
    MsgBox Err.Number & "; Description: ", vbOKOnly, _
    "Error"
    
    
    End If
    
    
    Set appExcel = Nothing
    Set wkb = Nothing
    Set wks = Nothing
    Set rng = Nothing
    Set msg = Nothing
    Set nms = Nothing
    Set fld = Nothing
    Set itm = Nothing
    
    
    Application.ScreenUpdating = True
    
    
    End Sub

    Excel Video Tutorials / Excel Dashboards Reports


  3. #3
    Join Date
    29th April 2008
    Posts
    15

    Re: Exporting a body of an email to excel using VBA

    Not sure how to edit my last post but it might be helpful to see the email. The emails can have other text before or after or have signature or no signature etc or be forwarded but the macro is dependent on these tags/labels being present in body of the email in the same order. I have removed identifying details but basically it will parse out the data between the tags of any length.

    Risk Owner: xxxxxx
    Counterparty: xxxxx
    Trade ID: ########
    Fee Leg ID: #######
    Termination Method: xxxxxx
    Termination amount: ########
    Expected Recovery: xxxxxxxxxxxxxxxxxxxxxxx

    Excel Video Tutorials / Excel Dashboards Reports


Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Possible Answers

  1. Exporting text from body of outlook email to excel
    By greylegface in forum Excel and/or Email Help
    Replies: 8
    Last Post: May 14th, 2013, 18:39
  2. Replies: 26
    Last Post: April 4th, 2013, 23:29
  3. Exporting text from email body to excel
    By clees in forum Excel and/or Email Help
    Replies: 7
    Last Post: February 6th, 2006, 16:44
  4. Email: Formating Email Body w/ VBA excel / Outlook
    By JJacob in forum Excel and/or Email Help
    Replies: 2
    Last Post: October 27th, 2003, 09:25

Bookmarks

Posting Permissions

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