View Full Version : Solved: Display Outlook Contacts in Word
Adaytay
07-06-2004, 07:49 AM
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...)
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
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
Cheers,
Ad
Anne Troy
07-06-2004, 09:04 AM
You know...Outlook is so whacky, I think we might want to get the version in here right away, Ad. :)
Adaytay
07-06-2004, 09:17 AM
I *think* its 2000 - Dom can you confirm please? (You'll need to register lol)
Ad
Anne Troy
07-06-2004, 09:20 AM
DomFino did register, Ad. :)
Little over an hour ago.
DomFino
07-07-2004, 06:31 AM
Thanks for everyones reply so far. Yes, I am using Word 2K and Windows 2K.
fumei
07-07-2004, 04:40 PM
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?
fumei
07-07-2004, 04:44 PM
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?
DomFino
07-08-2004, 04:34 AM
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
jamescol
07-08-2004, 03:27 PM
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
DomFino
07-09-2004, 04:16 AM
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/default.asp?url=/library/en-us/dninvb00/html/ivb0076.asp
jamescol
07-09-2004, 10:06 AM
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
JOrzech
07-10-2004, 06:24 AM
You may want to try:
Change Address Book settings
On the Tools menu, click E-mail Accounts.
Under Directory, select View or change existing directories or address books, and then click Next.
Click the address book you want to change, and then click Change.
Make the changes you want, and then click OK.
To change additional settings, click More Settings.
Click OK, and then click Finish.
This may also provide some useful information:
http://www.slipstick.com/contacts/insword.htm
DomFino
07-16-2004, 04:59 AM
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
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
Anne Troy
07-17-2004, 05:24 PM
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...
jamescol
07-17-2004, 07:45 PM
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.
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
Let us know if this works.
Cheers,
James
DomFino
07-19-2004, 07:40 AM
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?
If oItm.Class = olContact Then
jamescol
07-19-2004, 02:17 PM
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
DomFino
07-19-2004, 04:37 PM
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
fumei
07-19-2004, 10:15 PM
Dom, could you post a file with this form in it? I will include it in the Word Addin.
Thanks.
DomFino
07-21-2004, 04:33 AM
Gerry,
Hope the attached comes through okay.
Dom
DomFino
07-21-2004, 04:49 AM
Jame,
I did as you suggested and found that the code errors on the line that reads For Each oItm In oItems
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
jamescol
07-21-2004, 06:18 AM
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:
Dim oNspc As Outlook.NameSpace
Dim oItm As Outlook.ContactItem
Dim oItems As Outlook.Items
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
DomFino
07-21-2004, 07:01 AM
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
jamescol
07-21-2004, 03:59 PM
Dom,
It must be something related to the VBA in Off2000, and I do not have that version to test.
Try this way instead:
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
Hopefully this one will work for you.
James
DomFino
07-22-2004, 04:55 AM
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:
jamescol
07-22-2004, 08:00 PM
Dom,
Glad it's working!
James
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.