Convert Outlook Macro For Excel

[cjamps]

Can the following macro be converted to work with Excel instead of Word? Can contact address, city, state and zip be added as well as 3 additional blank columns?

Thanks

Public Sub InsertDataFromOutlook()
Dim strForename As String
Dim strSurname As String
Dim strAddress As String
Dim strHomePhone As String
Dim strCellPhone As String
Dim oTable As Table
Dim oRng As Range

    'Set up the formatting codes in strCode
    strForename = "<PR_GIVEN_NAME>"
    strSurname = "<PR_SURNAME>"
    strHomePhone = "<PR_HOME_TELEPHONE_NUMBER>"
    strCellPhone = "<PR_CELLULAR_TELEPHONE_NUMBER>"
    strAddress = "<PR_EMAIL_ADDRESS>"


    'Let the user choose the name in Outlook
    strSurname = Application.GetAddress("", strSurname, _
                                        False, 1, , , True, True)
    If strSurname = "" Then
        MsgBox "User cancelled or no name listed", , "Cancel"
        GoTo lbl_Exit
    End If
    strForename = Application.GetAddress("", strForename, _
                                         False, 2, , , True, True)
    strHomePhone = Application.GetAddress("", strHomePhone, _
                                          False, 2, , , True, True)
    strCellPhone = Application.GetAddress("", strCellPhone, _
                                          False, 2, , , True, True)
    strAddress = Application.GetAddress("", strAddress, _
                                        False, 2, , , True, True)

    If ActiveDocument.Tables.Count = 0 Then
        Set oTable = ActiveDocument.Tables.Add(ActiveDocument.Range, 1, 6)
        Set oRng = oTable.Rows(1).Cells(1).Range
        oRng.End = oRng.End - 1
        oRng.Text = "Last Name"
        Set oRng = oTable.Rows(1).Cells(2).Range
        oRng.End = oRng.End - 1
        oRng.Text = "First Name"
        Set oRng = oTable.Rows(1).Cells(3).Range
        oRng.End = oRng.End - 1
        oRng.Text = "Phone"
        Set oRng = oTable.Rows(1).Cells(4).Range
        oRng.End = oRng.End - 1
        oRng.Text = "Cell"
        Set oRng = oTable.Rows(1).Cells(5).Range
        oRng.End = oRng.End - 1
        oRng.Text = "Email Address"
        Set oRng = oTable.Rows(1).Cells(6).Range
        oRng.End = oRng.End - 1
        oRng.Text = "Amount Paid"
    Else
        Set oTable = ActiveDocument.Tables(1)
    End If
    oTable.Rows.Add
    Set oRng = oTable.Rows.Last.Cells(1).Range
    oRng.End = oRng.End - 1
    oRng.Text = strSurname
    Set oRng = oTable.Rows.Last.Cells(2).Range
    oRng.End = oRng.End - 1
    oRng.Text = strForename
    Set oRng = oTable.Rows.Last.Cells(3).Range
    oRng.End = oRng.End - 1
    oRng.Text = strHomePhone
    Set oRng = oTable.Rows.Last.Cells(4).Range
    oRng.End = oRng.End - 1
    oRng.Text = strCellPhone
    Set oRng = oTable.Rows.Last.Cells(5).Range
    oRng.End = oRng.End - 1
    oRng.Text = strAddress
lbl_Exit:
    Set oRng = Nothing
    Set oTable = Nothing
    Exit Sub
End Sub

Private Sub Document_New()

End Sub

 

[Dan_W]

There are two things you need to do:

1. rewrite references to the ActiveDocument and Table to ActiveWorkbook/Activesheet and Range.
2. the trickier part is the .getaddress method - this method is exclusive to Word, and so doesn't exist in Excel. It is possible, though, to control Word from Excel - so in theory you could create an instance of Word in the background and then run this method against that Word instance, but I haven't checked to see if that works. Microsoft have a helpful tutorial on how to do it here.

I expect that it might be easier if you just run your code in Word and then export the results to Excel. Is there a reason that's not possible?

 

[cjamps]

Thanks.
I hadn't realized it was so complicated. I organize courses and add each contact one by one but sometimes signups come a few days before, sometimes a few days afterwards, sometimes even a week or two after the course started. It would be much too tedious exporting quite a number of times for one course.

I do thank you for your time and effort. I was not able to understand the tutorial, I learnt I don't have the head for these things.
Stay healthy.

 

[Dan_W]

I don't think it's particularly tricky, and I wouldn't reach the conclusion about having a head for these things.
If the code above works for you in word, I really don't think it would be very difficult to export it to Excel - it certainly sounds less tedious than the current process.
But more importantly, I wonder whether there might be another way of automating this strand of work. Which tutorial did you watch?

 

[cjamps]

>helpful tutorial on how to do it here.
Code is hard for me to decipher. All those loops and definitions. I have the highest admiration for all those programmers out there.

All I am trying to accomplish is to export contacts from outlook and bring them to excel. If I can even choose a few contacts at once fine but I would have to run the macro quite a few times before the course starts.

 

[Dan_W]

If that's you're trying to do, I don't know that the code above is easiest way of doing it. No wonder you found it complicated - it is!
I looked at the link you posted - so I don't know if that's the particular tutorial you were intending ("Controlling One Microsoft Office Application from Another") because the one a few tutorials after it seems to do what you're after (below). But in any event, the tutorial you linked to is exactly what I was referring to in my point 2 above. This is precisely how you can control Word from Excel.

But more importantly - there is another tutorial there (3 or 4 down from the one you posted) that would appear to do exactly what you want - Import Outlook Contacts to a Worksheet
I ran it, and it works fine - I think it needs some tweaking, but is this not what you were after? It is written to run from Excel, and you will need to add a reference to the Outlook Office Object Library.

Sub Import_Contacts()

    'Outlook objects.
    Dim olApp As Outlook.Application
    Dim olNamespace As Outlook.Namespace
    Dim olFolder As Outlook.MAPIFolder
    Dim olConItems As Outlook.Items
    Dim olItem As Object
   
    'Excel objects.
    Dim wbBook As Workbook
    Dim wsSheet As Worksheet
   
    'Location in the imported contact list.
    Dim lnContactCount As Long
   
    Dim strDummy As String
   
    'Turn off screen updating.
    Application.ScreenUpdating = False
   
    'Initialize the Excel objects.
    Set wbBook = ThisWorkbook
    Set wsSheet = wbBook.Worksheets(1)
   
    'Format the target worksheet.
    With wsSheet
        .Range("A1").CurrentRegion.Clear
        .Cells(1, 1).Value = "Company / Private Person"
        .Cells(1, 2).Value = "Street Address"
        .Cells(1, 3).Value = "Postal Code"
        .Cells(1, 4).Value = "City"
        .Cells(1, 5).Value = "Contact Person"
        .Cells(1, 6).Value = "Email"
        With .Range("A1:F1")
            .Font.Bold = True
            .Font.ColorIndex = 10
            .Font.Size = 11
        End With
    End With
   
    wsSheet.Activate
   
    'Initialize the Outlook variables with the MAPI namespace and the default Outlook folder of the current user.
    Set olApp = New Outlook.Application
    Set olNamespace = olApp.GetNamespace("MAPI")
    Set olFolder = olNamespace.GetDefaultFolder(10)
    Set olConItems = olFolder.Items
           
    'Row number to place the new information on; starts at 2 to avoid overwriting the header
    lnContactCount = 2
   
    'For each contact: if it is a business contact, write out the business info in the Excel worksheet;
    'otherwise, write out the personal info.
    For Each olItem In olConItems
        If TypeName(olItem) = "ContactItem" Then
            With olItem
                If InStr(olItem.CompanyName, strDummy) > 0 Then
                    Cells(lnContactCount, 1).Value = .CompanyName
                    Cells(lnContactCount, 2).Value = .BusinessAddressStreet
                    Cells(lnContactCount, 3).Value = .BusinessAddressPostalCode
                    Cells(lnContactCount, 4).Value = .BusinessAddressCity
                    Cells(lnContactCount, 5).Value = .FullName
                    Cells(lnContactCount, 6).Value = .Email1Address
                Else
                    Cells(lnContactCount, 1) = .FullName
                    Cells(lnContactCount, 2) = .HomeAddressStreet
                    Cells(lnContactCount, 3) = .HomeAddressPostalCode
                    Cells(lnContactCount, 4) = .HomeAddressCity
                    Cells(lnContactCount, 5) = .FullName
                    Cells(lnContactCount, 6) = .Email1Address
                End If
                wsSheet.Hyperlinks.Add Anchor:=Cells(lnContactCount, 6), _
                                       Address:="mailto:" & Cells(lnContactCount, 6).Value, _
                                       TextToDisplay:=Cells(lnContactCount, 6).Value
            End With
            lnContactCount = lnContactCount + 1
        End If
    Next olItem
   
    'Null out the variables.
    Set olItem = Nothing
    Set olConItems = Nothing
    Set olFolder = Nothing
    Set olNamespace = Nothing
    Set olApp = Nothing
   
    'Sort the rows alphabetically using the CompanyName or FullName as appropriate, and then autofit.
    With wsSheet
        .Range("A2", Cells(2, 6).End(xlDown)).Sort key1:=Range("A2"), order1:=xlAscending
        .Range("A:F").EntireColumn.AutoFit
    End With
           
    'Turn screen updating back on.
    Application.ScreenUpdating = True
   
    MsgBox "The list has successfully been created!", vbInformation
End Sub

 

[cjamps]

Hi.

Thank you so much for your time and effort. Sorry it took so long - I was in the middle of a project and then my computer went.

This macro exports the contacts. The word macro allowed me to choose a contact from outlook & export one by one. Perhaps this macro does that but I got a runtime error '5' invalid procedure call or argument after 44 contacts exported.

 

[Dan_W]

There are ways of doing exactly what you want (I set them out above), wouldn't it be quicker to just import the contacts and then delete the one you don't want? As I said above, only Word has the function you're after.

Why can't you continue using Word? Is it not possible to simply export the results from Word to an excel spreadsheet (as the code above does) rather than to a table (as your code does)?

In terms of the Error 5 - where does the code break?