Michael,
My approach was as follows:
Dim myContactArray As Variant, intIndex As Integer
Private Sub cboContact_Change()
intIndex = cboContact.ListIndex
txtContactAddress.Text = Mid(myContactArray(intIndex),
InStr(myContactArray(intIndex), vbCrLf) + 2)
End Sub
Private Sub cmdCancel_Click()
Unload frmMyAddBook
End Sub
Private Sub UserForm_Initialize()
' Form to bring up Outlook contacts and insert either business, home or
' other address information. Uses QuickSort
Dim olapp As New Outlook.Application
Dim nspNameSpace As Outlook.NameSpace
Dim fldContacts As Outlook.MAPIFolder
Dim objContacts As Object
Dim objContact As Object
Dim myCount As Integer
Dim objItem As ContactItem
Dim strZLS As String
Dim intCurrentContact As Integer
On Error GoTo ErrorHandler
Set olapp = Outlook.Application
Set nspNameSpace = olapp.GetNamespace("MAPI")
Set fldContacts = nspNameSpace.GetDefaultFolder(olFolderContacts)
Set objContacts = fldContacts.Items.Restrict("[BusinessAddress]<> '" & _
strZLS & "'")
ReDim myContactArray(objContacts.Count - 1)
For Each objContact In objContacts
myContactArray(myCount) = objContact.FullName & vbCrLf &
objContact.BusinessAddress
myCount = myCount + 1
Next objContact
QuickSort myContactArray
cboContact.List = myContactArray
cboContact.ListIndex = 0
intIndex = cboContact.ListIndex
ErrorHandler:
If Err.Number <> 0 Then
MsgBox Err.Description & vbCr & "Help File: " & Err.HelpFile & vbCr
& _
"Help Context: " & Err.HelpContext & vbCr & _
"Error: " & Err.Number & vbCr & _
"Source: " & Err.Source, vbMsgBoxHelpButton, vbOKOnly
End If
End Sub
Public Sub QuickSort(ByRef vntArr As Variant, _
Optional ByVal lngLeft As Long = -2, _
Optional ByVal lngRight As Long = -2)
Dim I As Long
Dim j As Long
Dim lngMid As Long
Dim vntTestVal As Variant
If lngLeft = -2 Then lngLeft = LBound(vntArr)
If lngRight = -2 Then lngRight = UBound(vntArr)
If lngLeft < lngRight Then
lngMid = (lngLeft + lngRight) \ 2
vntTestVal = vntArr(lngMid)
I = lngLeft
j = lngRight
Do
Do While vntArr(I) < vntTestVal
I = I + 1
Loop
Do While vntArr(j) > vntTestVal
j = j - 1
Loop
If I <= j Then
Call SwapElements(vntArr, I, j)
I = I + 1
j = j - 1
End If
Loop Until I > j
' Optimize sort by sorting smaller segment first
If j <= lngMid Then
Call QuickSort(vntArr, lngLeft, j)
Call QuickSort(vntArr, I, lngRight)
Else
Call QuickSort(vntArr, I, lngRight)
Call QuickSort(vntArr, lngLeft, j)
End If
End If
End Sub
' Used in QuickSort function
Private Sub SwapElements(ByRef vntItems As Variant, _
ByVal lngItem1 As Long, _
ByVal lngItem2 As Long)
Dim vntTemp As Variant
vntTemp = vntItems(lngItem2)
vntItems(lngItem2) = vntItems(lngItem1)
vntItems(lngItem1) = vntTemp
End Sub
Michael Bauer said:
Hi Lucian,
please show us your current approach.
--
Viele Grüße
Michael Bauer
I've got a user defined dialog box to call up addresses like the
addressbook, but will allow me to insert the other addresses, not just
the
mailing address.
Based on the way many others have done this, I used an array, but I
have
about 1500 contacts and it takes a long time to load.
Is there:
1. a way of only having to go through the pain of waiting
only at
the start--- I notice that the built-in
address book in word takes quite a while to load my outlook
contacts
the first time, but is fast after that.
2. another approach that would be faster.
Lucian
