More Outlook Resource Sites

Microsoft Developer Network (MSDN)

FAQs and other general resources

forum 26-Jun-2017 10:13

Looking for help with Outlook programming projects — VSTO, add-ins, VBA, custom Outlook forms, etc.? You′ve come to the right place!

NEW! >> Subscribe to this site via RSS. For more RSS options, see the complete list of feeds on our main news page.

    Page [ 1 ]  
 Basic Outlook Printer Friendly Version
Working with Outlook items, folders, recipients; dealing with security; writing event handlers
Topic
Export outlook email with subject line to Excel - need to modify to add only required lines from email body
Hi

I got this VBA script working with Outlook 2010.
This script exports a email with a given subject line ("ABC Contact") with folder selected in outlook at run time and add all the contents of email body to Excel.

I need help to change it so that I can do the below;

1. I want to hard code the outlook folder to say "XYXmail" so that it does not prompt & select this folder always.
2. I need to add only specified 3 lines which is always starts with the with the below text.
   A. Name :
   B. Tel :
   C. Email :

Can someone help to change the below code to get the above 2?

Thanks in advance.

Sub ExportToExcel()
     
    On Error GoTo ErrHandler
     
    Dim appExcel As Excel.Application
    Dim wkb As Excel.Workbook
    Dim wks As Excel.Worksheet
    Dim rng As Excel.Range
    Dim workbookFile As String
    Dim msg As Outlook.MailItem
    Dim nms As Outlook.NameSpace
    Dim fld As Outlook.MAPIFolder
    Dim itm As Object
     
     'Folder path and file name of an existing Excel workbook
     
    workbookFile = "C:\Temp\OutlookItems.xlsx"
     
     'Select export folder
    Set nms = 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"
        Exit Sub
    ElseIf fld.DefaultItemType <> olMailItem Then
        MsgBox "There are no mail messages to export", vbOKOnly, _
        "Error"
        Exit Sub
    ElseIf fld.Items.Count = 0 Then
        MsgBox "There are no mail messages to export", vbOKOnly, _
        "Error"
        Exit Sub
    End If
     
     'Open and activate Excel workbook.
    Set appExcel = CreateObject("Excel.Application")
    Set wkb = appExcel.Workbooks.Open(workbookFile)
    Set wks = wkb.Sheets(1)
    wks.Activate
    appExcel.Application.Visible = True
    Set rng = wks.Range("A1")
     
     'Copy field items in mail folder.
     
    For Each itm In fld.Items
        If itm.Class = Outlook.OlObjectClass.olMail Then
            Set msg = itm
            If InStr(msg.Subject, "ABC Contact") > 0 And DateDiff("d", msg.SentOn, Now) <= 7 Then
                rng.Offset(0, 0).Value = msg.To
                rng.Offset(0, 1).Value = msg.SenderEmailAddress
                rng.Offset(0, 2).Value = msg.Subject
                rng.Offset(0, 3).Value = msg.SentOn
                rng.Offset(0, 4).Value = msg.Body
                Set rng = rng.Offset(1, 0)
            End If
        End If
    Next
     
    Set appExcel = Nothing
     
    Exit Sub
     
ErrHandler:
    If Err.Number = 1004 Then
        MsgBox workbookFile & " doesn't exist", vbOKOnly, _
        "Error"
    Else
        MsgBox "Error number: " & Err.Number & vbNewLine & _
        "Description: " & Err.Description, vbOKOnly, "Error"
    End If
     
End Sub

Mathew

  12-May-2013  22:12
    Page [ 1 ]