Solved: Display Outlook Contacts in Word

Hi folks,

This post was asked on another forum, I'm hoping someone here can help...

(I have, of course, let the user know that it's posted here and given him a link...)

Quote:

---

Originally Posted by DomFino

I have a MS Word 2000 template that uses the function below to open the address book in word so the uses can select a name from the list that then populates several fields in the template. Unfortunately, I can only get this to work with the default address book .

What I would prefer to do is have the Contact Folder open rather the default address book. I have searched the Internet and found a reference to:

GetAddressList
FolderName:=contactFolder

However, I am not sure this is what is needed here.

Can anyone help with identifying the correct modification to the code below so that the Application.GetAddress opens the Contact Folder?

Thanks,
Dom

---

[vba]
Public Sub InsertAddressFromOutlook()
Dim strCode As String, strAddress As String
Dim iDoubleCR As Integer

'Set up the formatting codes in strCode
strCode = "<PR_DISPLAY_NAME>" & vbCr & _
"<PR_POSTAL_ADDRESS>" & vbCr & _
"<PR_OFFICE_TELEPHONE_NUMBER>" & vbCr

'Display the 'Select Name' dialog, which lets the user choose
'a name from their Outlook address book
strAddress = Application.GetAddress(AddressProperties:=strCode, _
UseAutoText:=False, DisplaySelectDialog:=1, _
RecentAddressesChoice:=True, UpdateRecentAddresses:=True)
'If user cancelled out of 'Select Name' dialog, quit
If strAddress = "" Then Exit Sub

'Eliminate blank paragraphs by looking for two carriage returns in a row
iDoubleCR = InStr(strAddress, vbCr & vbCr)
Do While iDoubleCR <> 0
strAddress = Left(strAddress, iDoubleCR - 1) & _
Mid(strAddress, iDoubleCR + 1)
iDoubleCR = InStr(strAddress, vbCr & vbCr)
Loop

'Strip off final paragraph mark
strAddress = Left(strAddress, Len(strAddress) - 1)
'Insert the modified address at the current insertion point

Selection.Range.Text = strAddress

End Sub
[/vba]

Cheers,

Ad

You know...Outlook is so whacky, I think we might want to get the version in here right away, Ad. :)

I *think* its 2000 - Dom can you confirm please? (You'll need to register lol)

Ad

DomFino did register, Ad. :)
Little over an hour ago.

Thanks for everyones reply so far. Yes, I am using Word 2K and Windows 2K.

I am not sure what the problem is. I do not use Outlook, but I have it. My Contacts Folder wqs empty. I made one entry and ran the above code from Word. It opened the contacts list, and inserted the entry. name + email address.

What is the problem?

I just made 14 more (fake) entries, and the dialog box shows them all up, the one I select is inserted into the document.

Is it that it does not look like the Contacts Folder itself? It is the Select Name dialog, but the contents ARE the Contacts Folder contents. i do not have a Word AddressBook, I newly created entried right in the Contact Folder, and that is what shows.

What is the problem?

Gary,
Thanks for your time and effort. I may not have explained the problem well enough in my original post.

The code works fine. However, since we are on a network with many outlook folders for each department, division, etc., the following occurs.

The user double clicks on the field that triggers the code.
The outlook "Show Name From List" oppens to the default "Global Address List". The user must select the drop down and scroll through all the address lists until they find the "Contacts", which is at the bottom of a long list.

However, what I wanted to do is have the user doube click on the field that triggers the code. The outlook Show Name From List" will open to the "Contacts" rather then the "Global Address List".

Some how I need to have the GetAddressList command to set the
FolderName:=contactFolder

I hope this helps better explain the problem
Thanks again
Dom

I wrote an application that needed to do something similar. During my research, I was told there is no way to display on of the default dialog boxes and for it to display a specific addresslist. The built-in dialogs display whatever addresslist the Outlook user has chosen as his default.

To display a specific folder, you can use the Outlook View Control and set its default folder to what you want. To use this control, you need to add a UserForm, then add the appropriate controls and code.

Interestingly, you can access the contents of a specific address list programmatically. So you could also use a listbox control and populate it with the address entries of the PAB or Contacts folder.

If you wnt to pursue either option, let me know and I can post some code.

Cheers,
James

James,
Thanks for your reply. I understand what you are saying and have also done some additional research since my post. I found a link that shows me how to do exactly what I want. I have posted it below in case anyone else comes up with a similar need.

http://msdn.microsoft.com/library/de...ml/ivb0076.asp

I considered that article when I was developing my project. For performance reasons, I chose to use the Outlook View Control. A couple of items you might want to consider when using the code from that article:

1. The code doesn't test for the absence of any contacts. I know several users who don't use their Contacts folder. If they were to see an empty list box, they might get confused and call the helpdesk. So consider adding a test for this condition.

2. Since you are running OL2000, you are OK using the olFolderContacts. Keep in mind that prior to OL2000, contacts were stored in the Personal Address Book. If a user happens to still run an earlier version, the code will error.

Good luck! Post your completed code in the KB to share with everyone.

Cheers,
James

You may want to try:
Change Address Book settings

On the Tools menu, click E-mail Accounts.

1. Under Directory, select View or change existing directories or address books, and then click Next.
2. Click the address book you want to change, and then click Change.
3. Make the changes you want, and then click OK.
4. To change additional settings, click More Settings.
5. Click OK, and then click Finish.

This may also provide some useful information:
http://www.slipstick.com/contacts/insword.htm

Well, I went for following code to pop up a form that shows the Contacts data. It works great and is not too bad regarding response time needed to populate the listbox. I still need to figure out how to test for the absence of any contacts as suggested by James in the post above. However, the code does work and will do for now.

Thank you all for your input, comments, and suggestions.
Dom

[VBA]Public Sub InsertIntoDoc(All As Boolean)
Dim itm As Variant
With lstFieldList
For x = 0 To .ListCount - 1
If All Then .Selected(x) = All
If .Selected(x) = True Then
With Selection
.InsertAfter (lstFieldList.List(x))
.Collapse (wdCollapseEnd)
.Paragraphs.Add
End With
End If
Next x
End With
End Sub
Private Sub UserForm_Initialize()
Dim oNspc As NameSpace
Dim oItm As ContactItem
Dim x As Integer
If Not DisplayStatusBar Then
DisplayStatusBar = True
End If

StatusBar = "Please Wait..."
x = 0

Set oApp = CreateObject("Outlook.Application")
Set oNspc = oApp.GetNamespace("MAPI")
For Each oItm In oNspc.GetDefaultFolder _
(olFolderContacts).Items

With Me.cboContactList
.AddItem (oItm.FullName)
.Column(1, x) = oItm.BusinessAddress
.Column(2, x) = oItm.BusinessTelephoneNumber
End With
x = x + 1
Next oItm
StatusBar = ""
Set oItm = Nothing
Set oNspc = Nothing
Set oApp = Nothing

End Sub

Private Sub cboContactList_Change()
Dim x As Integer
With lstFieldList
If .ListCount > 0 Then
For x = 0 To .ListCount - 1
.RemoveItem (0)
Next x
End If
For x = 0 To cboContactList.ColumnCount - 1
.AddItem (Me.cboContactList.Column(x))
Next x
End With
End Sub

Private Sub cmbAll_Click()
Call InsertIntoDoc(True)
End Sub

Private Sub cmbDetail_Click()
Call InsertIntoDoc(False)
End Sub

Private Sub cmbClose_Click()
Unload Me
End Sub
[/VBA]

Hey, Dom. Good to hear it's working *so* far. So, you want to keep this open? I assume yes? Presumably, James can help with that...

James...if you can't, let's PM steph...

Hey Dom,
Glad to hear you are making progress! I modified your code to check for an empty Contacts folder and added an inner If..Then to only add Contacts to the list. If you want Distribution Lists added to your contact list, just remove the If..Then statement.
[vba]
Private Sub UserForm_Initialize()
Dim oNspc As NameSpace
Dim oItm As ContactItem
Dim oItems As Items


Dim x As Integer
If Not DisplayStatusBar Then
DisplayStatusBar = True
End If

StatusBar = "Please Wait..."
x = 0

Set oApp = CreateObject("Outlook.Application")
Set oNspc = oApp.GetNamespace("MAPI")
Set oItems = oNspc.GetDefaultFolder(olFolderContacts).Items

'Make sure the Contacts folder contains entries

If oItems.Count > 0 Then

For Each oItm In oItems

'Make sure the oItm is a contact and not a DL
'Remove this If...Then condition if you want to include DLs

If oItm.Class = olContact Then

With Me.cboContactList
.AddItem (oItm.FullName)
.Column(1, x) = oItm.BusinessAddress
.Column(2, x) = oItm.BusinessTelephoneNumber
End With
x = x + 1


End If
Next oItm
End If

StatusBar = ""
Set oItems = Nothing
Set oItm = Nothing
Set oNspc = Nothing
Set oApp = Nothing

End Sub
[/vba]

Let us know if this works.

Cheers,
James

Hi Dreamboat and James,

Thanks again for the suggestions and sample code. I tried the revised code without a distribution list and it works fine. However, if I add a distribution list, I receive the following error.

Run-Time error '13':
Type mismatch

I suspect the following line of code is the culpert but am not sure. Any Suggestios?

[VBA]If oItm.Class = olContact Then[/VBA]

Dom,
I copied the code from my post and it ran without the error you mention. My guess is that there is something else, like an unitialized/undeclared variable or something.

Try stepping through the procedure (highlight the procedure name and press F8, then F8 through every line), and find out exactly what triggers the error message.

Alternately, copy your code here exactly as you have it written and I will look at it.

Cheers
James

James,

Thanks for sticking with me on this problem. I really appreciate it and I am learning something new to boot.



I am out of the office all day tomorrow but will do as you suggested first thing Wednesday and post my result.

Thanks Again,

Dom

Dom, could you post a file with this form in it? I will include it in the Word Addin.

Thanks.

Gerry,
Hope the attached comes through okay.
Dom

Jame,
I did as you suggested and found that the code errors on the line that reads For Each oItm In oItems

[VBA]
Public Sub InsertIntoDoc(All As Boolean)
Dim itm As Variant
With lstFieldList
For x = 0 To .ListCount - 1
If All Then .Selected(x) = All
If .Selected(x) = True Then
With Selection
.InsertAfter (lstFieldList.List(x))
.Collapse (wdCollapseEnd)
.Paragraphs.Add
End With
End If
Next x
End With
End Sub
Sub UserForm_Initialize()
Dim oNspc As NameSpace
Dim oItm As ContactItem
Dim oItems As Items


Dim x As Integer
If Not DisplayStatusBar Then
DisplayStatusBar = True
End If

StatusBar = "Please Wait..."
x = 0

Set oApp = CreateObject("Outlook.Application")
Set oNspc = oApp.GetNamespace("MAPI")
Set oItems = oNspc.GetDefaultFolder(olFolderContacts).Items

'Make sure the Contacts folder contains entries

If oItems.Count > 0 Then

For Each oItm In oItems ' Error Occurs Here

'Make sure the oItm is a contact and not a DL
'Remove this If...Then condition if you want to include DLs

If oItm.Class = olContact Then
'If oItm.Class <> olDistributionList Then
With Me.cboContactList
.AddItem (oItm.FullName)
.Column(1, x) = oItm.BusinessAddress
.Column(2, x) = oItm.BusinessTelephoneNumber
End With
x = x + 1


End If
Next oItm
End If

StatusBar = ""
Set oItems = Nothing
Set oItm = Nothing
Set oNspc = Nothing
Set oApp = Nothing

End Sub
Private Sub cboContactList_Change()
Dim x As Integer
With lstFieldList
If .ListCount > 0 Then
For x = 0 To .ListCount - 1
.RemoveItem (0)
Next x
End If
For x = 0 To cboContactList.ColumnCount - 1
.AddItem (Me.cboContactList.Column(x))
Next x
End With
End Sub

Private Sub cmbAll_Click()
Call InsertIntoDoc(True)
End Sub
Private Sub cmbDetail_Click()
Call InsertIntoDoc(False)
End Sub
Private Sub cmbClose_Click()
Unload Me
End Sub
[/VBA]

Hi Dom,
The code you posted looks right, and works on my computer. I think you might be missing a reference. From your VBE, choose the Tools | References menu. In the list that appears, make sure that you have the checkbox marked for "Microsoft Outlook xx.0 Object Library", where xx is the version number for your Outlook.

This reference will make the Outlook object model visible to Word. Also, when you DIM your Outlook variables, be sure to qualify them with "Outlook" to differentiate them from Word objects. For instance:

[vba]
Dim oNspc As Outlook.NameSpace
Dim oItm As Outlook.ContactItem
Dim oItems As Outlook.Items
[/vba]

Otherwise, VBA assigns the default application's object to the variable. I should have caught that earlier for you.

Let us know what happens.

Cheers,
James

James,
I checked the Microsoft Outlook Object Library and it is checked.
I also changed the DIM Outlook variables to read as you suggested, however, I still get the same error.

FYI
If oItems.Count > 0 Then

In the line of code above the count shows as 22 which is correct. There are 22 contacts and 1 distribution list.

For Each oItm In oItems

The above line of code shows as oItm=Nothing

Dom,
It must be something related to the VBA in Off2000, and I do not have that version to test.

Try this way instead:
[vba]
Sub UserForm_Initialize()
Dim oNspc As Outlook.NameSpace
Dim oItems As Outlook.Items
Dim i, x As Integer

If Not DisplayStatusBar Then
DisplayStatusBar = True
End If

StatusBar = "Please Wait..."
x = 0

Set oApp = CreateObject("Outlook.Application")
Set oNspc = oApp.GetNamespace("MAPI")
Set oItems = oNspc.GetDefaultFolder(olFolderContacts).Items

'Make sure the Contacts folder contains entries

If oItems.Count > 0 Then

For i = 1 to oItems.Count

'Make sure the oItems(i) is a contact and not a DL
'Remove this If...Then condition if you want to include DLs

If oItems(i).Class = olContact Then

With Me.cboContactList
.AddItem (oItems(i).FullName)
.Column(1, x) = oItems(i).BusinessAddress
.Column(2, x) = oItems(i).BusinessTelephoneNumber
End With

x = x + 1

End If
Next i
End If

StatusBar = ""
Set oItems = Nothing
Set oNspc = Nothing
Set oApp = Nothing

End Sub
[/vba]

Hopefully this one will work for you.

James

James,
We have ignition:yay

Worked like a charm. I am not sure why your latest version did the trick, but as you said, it must be a quirk with VBA in Off2000.

Thank you so much for your efforts. I certainly would have never figured this one out by myself.

Dom:hi:

Dom,
Glad it's working!

James