Solved

Outlook Macro Export Fields To Named Excel Workbook

Posted on 2013-05-21
18
795 Views
Last Modified: 2014-01-28
I've searched EE for applicable macro code, but have not found anything that works.

From the Outlook 2010 Inbox we need to export 7 fields to an open Excel workbook, to specific columns.

We do this weekly, and the fields need to be added to the bottom of the prior week's export (exisisting data). There is a Header Row, so the first avaiable cell is A2.

The fields are:

Subject - column A
FromName - column B
FromAddress - column C
ToName - column D
ToAddress - Column E
ccName - Column F
ccAddress - Column G

I know this can be done manually in 2010, but we need a macro to turn this project over to others without training.


Any assistance or suggestions would be appreciated.

Tosagua
0
Comment
Question by:Tosagua
  • 8
  • 7
  • 3
18 Comments
 
LVL 35

Expert Comment

by:[ fanpages ]
ID: 39186028
Hi,

Do you wish the existing Microsoft Excel workbook to retrieve the data (with the Visual Basic for Applications code to do this residing within the workbook), or for Outlook session to open the workbook, transfer the data, save, & then close the workbook?

Will multiple parties be undertaking this task (potentially) concurrently, or will a single party be responsible for transferring the contents from their Outlook session to the workbook?

BFN,

fp.
0
 

Author Comment

by:Tosagua
ID: 39187347
BFN,

Yes, the Excel workbook should retrieve the data.

To keep this as simple as possible, one person, at one time, will open the existing workbook that holds the macro, open the email account, and run  the macro to extract the information. But that person will change periodically.

Background: We are required to have a 'form', approval, and tracking, for approximately 500 new transactions each week. We developed an Excel form with a button that creates an email with a reference no. in the subject line. We need to extract the reference no. (and other fields) to compare to reference no.s in a report of all possible transactions, to see what was approved. The comparison part is a separate macro and we should not have a problem with its development. The email account is a separate account and only receives the approval 'forms'.

Your assistance is appreciated.

Tosagua
0
 
LVL 35

Expert Comment

by:[ fanpages ]
ID: 39187422
So you have data in MS-Excel that is used in the subject line of an e-mail created by the Excel workbook.

You now wish to re-read the information back into a(nother) workbook.

Why not just store the data used to create the e-mails at the time of creation & use that list instead of having to read from an MS-Outlook session?
0
 
LVL 76

Expert Comment

by:David Lee
ID: 39187637
Hi, Tosagua.

Try this.  It's a knockoff of Revision 2 of the code I wrote for this post on my blog.

'On the next line change the value to True if you want each export to go on a new sheet.
Const EXPORT_NEWSHEET = False
Const MACRO_NAME = "Export Messages to Excel"

Sub ExportController()
    'Add as many exports as you need. Each export is controlled by a line like the following
    'The format of the command is ExportMessagesToExcel "Path to Workbook", Outlook folder
    ExportMessagesToExcel "C:\Tosagua.xlsx", Session.GetDefaultFolder(olFolderInbox)
    MsgBox "Process complete.", vbInformation + vbOKOnly, MACRO_NAME
End Sub

Sub ExportMessagesToExcel(strFilename As String, olkFld As Outlook.MAPIFolder)
    Dim olkMsg As Object, _
        olkRcp As Outlook.RECIPIENT, _
        excApp As Object, _
        excWkb As Object, _
        excWks As Object, _
        intRow As Integer, _
        intVer As Integer, _
        strToName As String, _
        strToAddr As String, _
        strCCName As String, _
        strCCAddr As String
    If strFilename <> "" Then
        If TypeName(olkFld) <> "Nothing" Then
            intVer = GetOutlookVersion()
            Set objFSO = CreateObject("Scripting.FileSystemObject")
            Set excApp = CreateObject("Excel.Application")
            If objFSO.FileExists(strFilename) Then
                Set excWkb = excApp.Workbooks.Open(strFilename)
                If EXPORT_NEWSHEET Then
                    Set excWks = excWkb.Worksheets.Add()
                    excWks.Name = Format(Date, "m-dd-yy")
                Else
                    Set excWks = excWkb.Worksheets(1)
                End If
            Else
                Set excWkb = excApp.Workbooks.Add()
                Set excWks = excWkb.Worksheets(1)
            End If
            'Write Excel Column Headers
            With excWks
                .Cells(1, 1) = "Subject"
                .Cells(1, 2) = "From Name"
                .Cells(1, 3) = "From Address"
                .Cells(1, 4) = "To Name"
                .Cells(1, 5) = "To Address"
                .Cells(1, 6) = "CC Name"
                .Cells(1, 7) = "CC Address"
            End With
            intRow = 2
            'Write messages to spreadsheet
            For Each olkMsg In olkFld.Items
                If olkMsg.Class = olMail Then
                    strToName = ""
                    strToAddr = ""
                    strCCName = ""
                    strCCAddr = ""
                    For Each olkRcp In olkMsg.Recipients
                        Select Case olkRcp.Type
                            Case olTo
                                strToName = strToName & olkRcp.Name & "; "
                                strToAddr = strToAddr & X400toSMTP(olkRcp.AddressEntry.Address) & "; "
                            Case olCC
                                strCCName = strCCName & olkRcp.Name & "; "
                                strCCAddr = strCCAddr & X400toSMTP(olkRcp.AddressEntry.Address) & "; "
                        End Select
                    Next
                    'Add a row for each field in the message you want to export
                    excWks.Cells(intRow, 1) = olkMsg.Subject
                    excWks.Cells(intRow, 2) = olkMsg.SenderName
                    excWks.Cells(intRow, 3) = GetSMTPAddress(olkMsg, intVer)
                    If Len(strToName) > 0 Then
                        excWks.Cells(intRow, 4) = Left(strToName, Len(strToName) - 2)
                    Else
                        excWks.Cells(intRow, 4) = ""
                    End If
                    If Len(strToAddr) > 0 Then
                        excWks.Cells(intRow, 5) = Left(strToAddr, Len(strToAddr) - 2)
                    Else
                        excWks.Cells(intRow, 5) = ""
                    End If
                    If Len(strCCName) > 0 Then
                        excWks.Cells(intRow, 6) = Left(strCCName, Len(strCCName) - 2)
                    Else
                        excWks.Cells(intRow, 6) = ""
                    End If
                    If Len(strCCAddr) > 0 Then
                        excWks.Cells(intRow, 7) = Left(strCCAddr, Len(strCCAddr) - 2)
                    Else
                        excWks.Cells(intRow, 7) = ""
                    End If
                    intRow = intRow + 1
                End If
            Next
            Set olkMsg = Nothing
        Else
            MsgBox "The folder pointed to by the path '" & strFolderPath & "' does not exist in Outlook.", vbCritical + vbOKOnly, MACRO_NAME
        End If
    Else
        MsgBox "The filename was empty.", vbCritical + vbOKOnly, MACRO_NAME
    End If
    If objFSO.FileExists(strFilename) Then
        excWkb.Save
    Else
        excWkb.SaveAs strFilename
    End If
    excWkb.Close True
    Set olkMsg = Nothing
    Set olkFld = Nothing
    Set excWks = Nothing
    Set excWkb = Nothing
    Set excApp = Nothing
End Sub

Private Function GetSMTPAddress(Item As Outlook.MailItem, intOutlookVersion As Integer) As String
    Dim olkSnd As Outlook.AddressEntry, olkEnt As Object
    On Error Resume Next
    Select Case intOutlookVersion
        Case Is < 14
            If Item.SenderEmailType = "EX" Then
                GetSMTPAddress = SMTP2007(Item)
            Else
                GetSMTPAddress = Item.SenderEmailAddress
            End If
        Case Else
            Set olkSnd = Item.Sender
            If olkSnd.AddressEntryUserType = olExchangeUserAddressEntry Then
                Set olkEnt = olkSnd.GetExchangeUser
                GetSMTPAddress = olkEnt.PrimarySmtpAddress
            Else
                GetSMTPAddress = Item.SenderEmailAddress
            End If
    End Select
    On Error GoTo 0
    Set olkPrp = Nothing
    Set olkSnd = Nothing
    Set olkEnt = Nothing
End Function

Function GetOutlookVersion() As Integer
    Dim arrVer As Variant
    arrVer = Split(Outlook.Version, ".")
    GetOutlookVersion = arrVer(0)
End Function

Function SMTP2007(olkMsg As Outlook.MailItem) As String
    Dim olkPA As Outlook.PropertyAccessor
    On Error Resume Next
    Set olkPA = olkMsg.PropertyAccessor
    SMTP2007 = olkPA.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x5D01001E")
    On Error GoTo 0
    Set olkPA = Nothing
End Function

Function X400toSMTP(strAdr As String) As String
    Dim olkRcp As Outlook.RECIPIENT, olkUsr As Outlook.ExchangeUser
    Set olkRcp = Session.CreateRecipient(strAdr)
    If olkRcp.AddressEntry.AddressEntryUserType = olExchangeUserAddressEntry Then
        olkRcp.Resolve
        Set olkUsr = olkRcp.AddressEntry.GetExchangeUser
        X400toSMTP = olkUsr.PrimarySmtpAddress
    Else
        X400toSMTP = strAdr
    End If
    Set olkRcp = Nothing
    Set olkUsr = Nothing
End Function

Open in new window

0
 

Author Comment

by:Tosagua
ID: 39189025
BlueDevilFan,

Just to clarify, this script is run from Outlook, and not from the Excel woorkbook.

Tosagua
0
 
LVL 76

Expert Comment

by:David Lee
ID: 39189030
That's correct.
0
 

Author Comment

by:Tosagua
ID: 39192061
BlueDevilFan,

In between crises, I have been working on the macro, but I encoutered a 'Run-time error.
I think I missed a step. An object could not be found.
See attached file.

Please advise.

Tosagua
Outlook-Export.docx
0
 
LVL 35

Expert Comment

by:[ fanpages ]
ID: 39192175
I will withdraw interest in this thread, then.
0
 
LVL 76

Expert Comment

by:David Lee
ID: 39192236
Tosagua,

Are you familiar with using the debugger in Outlook?  If so, please check to see if olkRcp is a recipient object.  If it is, then look at its properties and see if AddressEntry is set to Nothing.
0
Maximize Your Threat Intelligence Reporting

Reporting is one of the most important and least talked about aspects of a world-class threat intelligence program. Here’s how to do it right.

 

Author Comment

by:Tosagua
ID: 39192579
BlueDevilFan,

I cannot find olkRcp. The Debug is rather limited, and I cannot find the properties of the classes. See attached. This is Visual Basic for Applications 7.0, under Outlook 2010.

Tosagua
Outlook-Export--2.docx
0
 
LVL 76

Expert Comment

by:David Lee
ID: 39192770
You're looking in the list of objects.  That's not the right place.  If it's not already visible, turn on the "Locals Window" (View > Locals Window).  It'll appear at the bottom of the screen.  Look for olkRcp.
0
 

Author Comment

by:Tosagua
ID: 39194163
BlueDevilFan,

Found it. See attached.

Tosagua
Outlook-Export--3.docx
0
 
LVL 76

Expert Comment

by:David Lee
ID: 39194196
Interesting.  Please replace the function X400toSMTP with the version below and try again.  Although the code worked fine when I tested it I see that I had one line out of place.  I've corrected that in this version.

Function X400toSMTP(strAdr As String) As String
    Dim olkRcp As Outlook.RECIPIENT, olkUsr As Outlook.ExchangeUser
    Set olkRcp = Session.CreateRecipient(strAdr)
    olkRcp.Resolve
    If olkRcp.AddressEntry.AddressEntryUserType = olExchangeUserAddressEntry Then
        Set olkUsr = olkRcp.AddressEntry.GetExchangeUser
        X400toSMTP = olkUsr.PrimarySmtpAddress
    Else
        X400toSMTP = strAdr
    End If
    Set olkRcp = Nothing
    Set olkUsr = Nothing
End Function

Open in new window

0
 

Author Comment

by:Tosagua
ID: 39194415
BlueDevilFan,

Although you moved the "olkRcp.Resolve", above the offending:
"If olkRcp.AddressEntry.AddressEntryUserType = olExchangeUserAddressEntry Then" line,
It is the same error message, "An object cannot be found".

The only script that I modified was in the Sub Export Controller() :

Sub ExportController()
    'Add as many exports as you need. Each export is controlled by a line like the following
    'The format of the command is ExportMessagesToExcel "Path to Workbook", Outlook folder

    ExportMessagesToExcel "I:\WHSE\BDG\Outlook\Inbox.xlsx", Session.GetDefaultFolder(olFolderInbox)

    MsgBox "Process complete.", vbInformation + vbOKOnly, MACRO_NAME
End Sub

Tosagua
0
 
LVL 76

Expert Comment

by:David Lee
ID: 39201000
Apparently the code is unable to resolve the address being passed.  I can't imagine how that's possible.  The message came in with that address so there's no reason I can think of why Outlook shouldn't be able to resolve it.
0
 

Author Comment

by:Tosagua
ID: 39211620
BlueDevilFan,

Since it is an Object that cannot be found, could this have anything to do with early binding, as opposed to late binding ? Did an Object have to be defined at a prior point ?

Tosaqua
0
 
LVL 76

Accepted Solution

by:
David Lee earned 500 total points
ID: 39218492
No, it doesn't have anything to do with early/late binding.  It's not a matter of defining the object, it's a matter that the object isn't getting a value.  This command creates a recipient object based on the address (strAdr) passed to it

    Set olkRcp = Session.CreateRecipient(strAdr)

The Recipient object is being created but a sub-component, AddressEntry, of that object has no value.  That's why the next command

    If olkRcp.AddressEntry.AddressEntryUserType = olExchangeUserAddressEntry Then

fails.  I don't understand how that's possible.  I tested the code in my Exchange environment, passing it one X400 address after another, and it always worked.  I looked back at the screen shot you sent and the Resolved property, which indicates whether Outlook has been able to resolve a recipient to an address, was False.  That's why I moved the command

    olkRcp.Resolve

up in the code.  I was attempting to force Outlook to resolve the address before testing it.  Apparently Outlook still can't resolve the entry to an address.  The question is why?  Outlook/Exchange only uses X400 addresses inside of an Exchange organization.  In other words, the address belongs to an entry in your Exchange organization.  How then can Outlook fail to resolve it?  That's what has me stumped.
0
 

Author Comment

by:Tosagua
ID: 39257421
Another solution has been used.

Really appreciate everyone's input.

Thank you,

Tosagua
0

Featured Post

What Should I Do With This Threat Intelligence?

Are you wondering if you actually need threat intelligence? The answer is yes. We explain the basics for creating useful threat intelligence.

Join & Write a Comment

A list of useful business intelligence software.
If your app took Google’s lash recently, here are the 5 most likely reasons.
The viewer will learn how to create two correlated normally distributed random variables in Excel, use a normal distribution to simulate the return on different levels of investment in each of the two funds over a period of ten years, and, create a …
The viewer will learn how to successfully create a multiboot device using the SARDU utility on Windows 7. Start the SARDU utility: Change the image directory to wherever you store your ISOs, this will prevent you from having 2 copies of an ISO wit…

747 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

13 Experts available now in Live!

Get 1:1 Help Now