It's possible but you might have to do some tweaking to get exactly what you
want.
The function and subroutine below is one I use to populate sheet(1) with
first name, last name, and email address. I keep postal address info in
Access but this could be expanded to extract the info from any of the fields
you use in Outlook. I also suspect that you want some sort of form with a
drop down list of Contacts which can also be done but would be a bit of
work, especially not knowing exactly how you want the whole thing to work.
Hope this gives you a decent head start. I suspect some will have routines
closer to what you want.
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
