• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 870
  • Last Modified:

Outlook Macro Export Fields To Named Excel Workbook

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
Tosagua
Asked:
Tosagua
  • 8
  • 7
  • 3
1 Solution
 
[ fanpages ]IT Services ConsultantCommented:
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
 
TosaguaAuthor Commented:
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
 
[ fanpages ]IT Services ConsultantCommented:
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
NEW Veeam Backup for Microsoft Office 365 1.5

With Office 365, it’s your data and your responsibility to protect it. NEW Veeam Backup for Microsoft Office 365 eliminates the risk of losing access to your Office 365 data.

 
David LeeCommented:
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
 
TosaguaAuthor Commented:
BlueDevilFan,

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

Tosagua
0
 
David LeeCommented:
That's correct.
0
 
TosaguaAuthor Commented:
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
 
[ fanpages ]IT Services ConsultantCommented:
I will withdraw interest in this thread, then.
0
 
David LeeCommented:
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
 
TosaguaAuthor Commented:
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
 
David LeeCommented:
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
 
TosaguaAuthor Commented:
BlueDevilFan,

Found it. See attached.

Tosagua
Outlook-Export--3.docx
0
 
David LeeCommented:
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
 
TosaguaAuthor Commented:
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
 
David LeeCommented:
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
 
TosaguaAuthor Commented:
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
 
David LeeCommented:
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
 
TosaguaAuthor Commented:
Another solution has been used.

Really appreciate everyone's input.

Thank you,

Tosagua
0

Featured Post

Concerto Cloud for Software Providers & ISVs

Can Concerto Cloud Services help you focus on evolving your application offerings, while delivering the best cloud experience to your customers? From DevOps to revenue models and customer support, the answer is yes!

Learn how Concerto can help you.

  • 8
  • 7
  • 3
Tackle projects and never again get stuck behind a technical roadblock.
Join Now