Outlook address
marijan glavac
I am using Outlook 2000 and Excel2000.
I would like to use data from address book (outlook) in my workbook but I
don't know how to do this.
The macro should do next :
When I choose a name from address book - I automatically get phone number
and street
address,phone number in specific cells.
Can anyone help me ?
Jim Rech
how to access the Outlook contacts list. This requires that a reference be
set to the Outlook Object library.
Sub Simple_Contact()
Dim WorkingFolder As Outlook.MAPIFolder
Dim objItem As Outlook.ContactItem
Dim StartCell As Object
Dim Cnt As Integer
Dim olMAPI As New Outlook.Application
ActiveSheet.Cells.Clear
Set WorkingFolder =
olMAPI.GetNamespace("MAPI").GetDefaultFolder(olFolderContacts)
Set StartCell = Range("A4")
With StartCell
.Resize(1, 4).Value = Array("Name", "Bus Phone", "Home Phone",
"EMail")
For Cnt = 1 To WorkingFolder.Items.Count
Set objItem = WorkingFolder.Items(Cnt)
.Offset(Cnt, 0).Value = objItem.FullName
.Offset(Cnt, 1).Value = objItem.BusinessTelephoneNumber
.Offset(Cnt, 2).Value = objItem.HomeTelephoneNumber
.Offset(Cnt, 3).Value = objItem.eMail1Address
Next Cnt
End With
ActiveSheet.Columns.AutoFit
Set objItem = Nothing
Set WorkingFolder = Nothing
Set olMAPI = Nothing
If Not IsNull(Application.MailSession) Then Application.MailLogoff
End Sub
--
Jim Rech
Excel MVP
marijan glavac
English isn't my native language and I am awear of that.
When I write letters or faxes or offers I need to type name ,company and
phone number of person whom I am sending.
All that I have in Outlook allready. I am sick and tierd of typing same
thing.
My wish is to select from Outlook one record (pearson) and all data (phone
number,company,fax...) will be put into specific cells.
Can you change your code ?
new2Excel
However the first dim line (WorkingFolder As
Outlook.MAPIFolder
) of the vba code doesn't work for me. There's
error: "Compile error: 'User-defined type not defined"
Any help on this?
>.
>
Jim Rech
did.
new2excel
file or what is the exact filename (.dll) to set the
reference to? seems i need more guidance, eh?
thanks again jim
>.
>
new2Excel
MSOUTL9.DLL. It did great. NOW... how about he toher way
around? from an Excel to Outlook. do you have idea/guide
to do this other way? thanks JIM>
>.
>
Jim Rech
would bet that it can be done but I'm only slightly familiar with the
Outlook object model and would have to play around with it. Better for you
to play around with it, don't you think?<g>
Julian Lim
I've done this before using CDO in Excel. Here is my sample code to
extract display name an SMTP email address from by outlook Global
Address Book. You need to have CDO 1.21 installed. You can get it from
http://ourworld.compuserve.com/homepages/attac-cg/cdolib.htm
Option Explicit
Dim objCdoSession
Dim colMsgs
Function ReadGBA()
On Error Resume Next
Dim objAddressList ' Global address list
Dim objAddressEntries ' AddressEntries
Dim objAddressEntry ' AddressEntry
Dim objAddressField ' Field object
Dim objAddressFields ' Fields collection
Dim objtemp
Dim strOrganization
Dim I
' Initialize objects
Set objAddressList = Nothing
Set objAddressEntries = Nothing
Set objAddressEntry = Nothing
Set objAddressField = Nothing
Set objAddressFields = Nothing
Set objCdoSession = Nothing
Set colMsgs = Nothing
If LogonCDO = True Then
Worksheets("Sheet1").Cells(1, 1) =
objCdoSession.CurrentUser.Name
Worksheets("Sheet1").Cells(2, 1) =
objCdoSession.CurrentUser.Address
strOrganization = objCdoSession.CurrentUser.Address
' 0 for Global Address book
' 1 for Personal Address book
Set objAddressList = objCdoSession.GetAddressList(0)
Set objAddressEntries = objAddressList.AddressEntries
Set objAddressFields = objAddressList.AddressEntries.Fields
' Get Name from Address Book
Worksheets("Sheet1").Cells(5, 1) =
objAddressEntries.GetFirst()
Set objtemp = objAddressEntries.GetFirst()
Set objAddressFields = objtemp.Fields
' Get SMTP from Address Book
Worksheets("Sheet1").Cells(5, 2) =
objAddressFields.Item(&H39FE001E).Value
I = 1
Do
Worksheets("Sheet1").Cells(5 + I, 1) =
objAddressEntries.GetNext()
If Trim(objAddressEntries.GetNext()) = "" Then
Exit Do
End If
Set objtemp = objAddressEntries.GetNext()
Set objAddressFields = objtemp.Fields
Worksheets("Sheet1").Cells(5 + I, 2) =
objAddressFields.Item(&H39FE001E).Value
I = I + 1
Loop
End If
End Function
Function LogonCDO() As Boolean
On Error Resume Next
LogonCDO = True
Set objCdoSession = CreateObject("MAPI.Session")
If Not objCdoSession.Version >= 1.21 Then
Set objCdoSession = Nothing
LogonCDO = False
Else
objCdoSession.Logon , , True, False, -1, True
End If
If Err Then LogonCDO = False
End Function
-----------------------------------------------------------------
Use this as reference to extract your desire field.
&H3001001E Display (name)
&H3A00001E Alias
&H3A0F001E Exchange server alias *
&H3A06001E First (name)
&H3A0A001E Initials
&H3A11001E Last (name)
&H3A29001E Address
&H3A17001E Title
&H3A16001E Company
&H3A27001E City
&H3A18001E Department
&H3A28001E State
&H3A19001E Office
&H3A2A001E Zip code
&H3A30001E Assistant
&H3A26001E Country
&H3A08001E Phone
&H3A1B001E Business 2
&H3A23001E Fax
&H3A2E001E Assistant
&H3A09001E Home
&H3A2F001E Home 2
&H3A1C001E Mobile
&H3A21001E Pager
&H3004001E Notes
&H39FE001E SMTP e-mail address
"Jim Rech" <jar...@kpmg.com> wrote in message news:<u1DxrOoGBHA.696@tkmsftngp04>...
Julian Lim
Realise some mistakes after posting the source code, here is the
correct one :
Set objtemp = objAddressEntries.GetFirst()
Worksheets("Sheet1").Cells(5, 1) = objtemp
Set objAddressFields = objtemp.Fields
Worksheets("Sheet1").Cells(5, 2) =
objAddressFields.Item(&H39FE001E).Value
I = 6
Do
Set objtemp = objAddressEntries.GetNext()
If Trim(objtemp) = "" Then
Exit Do
End If
Worksheets("Sheet1").Cells(I, 1) = objtemp
Set objAddressFields = objtemp.Fields
Worksheets("Sheet1").Cells(I, 2) =