Loading
Ozgrid Excel Help & Best Practices Forums

Excel Video Tutorials / 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
    12

    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).

    VB:
    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
    12

    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, 17:39
  2. Replies: 26
    Last Post: April 4th, 2013, 22: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, 15: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, 08: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