How to use outlook address in Excel

[Guest]

Hello,

I have an Excel sheet which I use as an invoicing-application. I would like
to retrieve address-data from Outlook where I keep all my contact-data of my
customers. So, I want to select a customer from my Outlook contactlist when I
am writing a new invoice in Excel.

In Word, I have a macro which does this, but unfortunately the
Application.GetAddress does not work in Excel.

Can somebody help me ?

 

[Guest]

Hello,

I have an Excel sheet which I use as an invoicing-application. I would like
to retrieve address-data from Outlook where I keep all my contact-data of my
customers. So, I want to select a customer from my Outlook contactlist when I
am writing a new invoice in Excel.

In Word, I have a macro which does this, but unfortunately the
Application.GetAddress does not work in Excel.

Can somebody help me ?

 

[Steve Yandl]

Below is a macro that I use to pull just first and last name plus email
address from my Outlook contacts. It would be a pretty simple modification
to grab street address infomation instead but I only keep email info in
Outlook. Above the code window, go to Tools>References and set a reference
to "Microsoft Outlook 11.0 Object library" (you may have something other
than 11). You could either modify this to place the data to a sheet not
being used (this places the list of contact info on sheet1 as written) or
you might want to fill an array or set up a list box. It just gives you an
idea of how to access items in an Outlook folder (in this case, Contacts).

-------------------------------------

Public olApp As Outlook.Application
Public olNS As Outlook.NameSpace


Function InitOutlook() As Boolean
On Error GoTo Init_Error
Set olApp = New Outlook.Application
Set olNS = olApp.GetNamespace("MAPI")

InitOutlook = True

Init_End:
Exit Function
Init_Error:
InitOutlook = False
Resume Init_End
End Function

Sub ContactGrab()
Dim fdContacts As Outlook.MAPIFolder
Dim fdItems As Outlook.Items
Dim fdItem As Object
Dim R As Integer

If olApp Is Nothing Then
If InitOutlook = False Then
MsgBox "Unable to initialize Outlook application or namespace"
Exit Sub
End If
End If

Set fdContacts = olNS.GetDefaultFolder(olFolderContacts)
Set fdItems = fdContacts.Items

Sheets("Sheet1").UsedRange.Clear

R = 1
With Sheets("Sheet1")
.Rows("1").Font.Bold = True
.Cells(1, 1).Value = "Contacts First Name"
.Cells(1, 2).Value = "Contacts Last Name"
.Cells(1, 3).Value = "Contacts Email Address"
.Columns("A").ColumnWidth = 32
.Columns("B").ColumnWidth = 36
.Columns("C").ColumnWidth = 26

End With

For Each fdItem In fdItems
On Error Resume Next
R = R + 1
With Sheets("Sheet1")
.Cells(R, 1).Value = fdItem.FirstName
.Cells(R, 2).Value = fdItem.LastName
.Cells(R, 3).Value = fdItem.Email1Address
End With
Next

End Sub


Steve