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
