I think that if what you want to do is change the way the names are
displayed, you will need to use a userform that is populated with the
Outlook Contact Details.
Here is the code that you would use in the Initialize event of the userform
to populate a combobox on the form with Outlook Contact details:
Private Sub UserForm_Initialize()
Dim oApp As Outlook.Application
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.LastName & ", " & oItm.FirstName)
.Column(1, x) = oItm.BusinessAddress
.Column(2, x) = oItm.BusinessAddressCity
.Column(3, x) = oItm.BusinessAddressState & ", " &
oItm.BusinessAddressPostalCode
' .Column(4, x) = oItm.BusinessAddressPostalCode
End With
x = x + 1
Next oItm
StatusBar = ""
Set oItm = Nothing
Set oNspc = Nothing
Set oApp = Nothing
Dim MyArray() As Variant, i As Integer, j As Integer, m As Integer, n As
Integer, target As Document, newtable As Table, myitem As Range
'Load client data into MyArray
MyArray = cboContactList.List()
' Create a new document containing a table
Application.ScreenUpdating = False
Set target = Documents.Add
Set newtable = target.Tables.Add(Range:=target.Range(0, 0),
numrows:=cboContactList.ListCount, NumColumns:=5)
' Populate the cells of the table with the contents of the array
For i = 1 To cboContactList.ListCount
For j = 1 To 4
newtable.Cell(i, j).Range.InsertBefore MyArray(i - 1, j - 1)
Next j
Next i
' sort the table
newtable.Sort ExcludeHeader:=False ', FieldNumber:="Column 1",
SortFieldType:=wdSortFieldText, SortOrder:=wdSortOrderAscending
i = newtable.Rows.Count
' Get the number of columns in the table of client details
j = 4
' Set the number of columns in the Listbox to match
' the number of columns in the table of client details
cboContactList.ColumnCount = 4
' Define an array to be loaded with the client data
Dim NewArray() As Variant
'Load client data into MyArray
ReDim NewArray(i, j)
For n = 0 To j - 1
For m = 0 To i - 1
Set myitem = newtable.Cell(m + 1, n + 1).Range
myitem.End = myitem.End - 1
NewArray(m, n) = myitem.Text
Next m
Next n
' Load data into ListBox1
cboContactList.List() = NewArray
target.Close wdDoNotSaveChanges
Application.ScreenUpdating = True
End Sub
If you have not come across userforms, See the article "How to create a
Userform" at:
http://word.mvps.org/FAQs/Userforms/CreateAUserForm.htm
--
Hope this helps.
Please reply to the newsgroup unless you wish to avail yourself of my
services on a paid consulting basis.
Doug Robbins - Word MVP
