Retrieving contact data without using a MAPI call

S

SDecou

Using the code below I am able to retrieve my Outlook contact folders and the
contact data within them. We are using Outlook 2003 in cashed mode with one
centralized server. Even though the contact data is cashed locally when I
use the code below it is not using looking at the cashed data - it is
traveling across our WAN to retrieve the data. For one folder with 615
contacts it could take up to 30 seconds to display this data in code. Is
this a way to retrieve contact data without using a MAPI call - to look at
the cashed data? What could I do to make this faster.
Sub GetFolderCount()
Dim MyFolder As Outlook.MAPIFolder
Dim j As Long
Dim MailboxName As String
Dim MailboxLoc As Integer

Set myOutlook = CreateObject("Outlook.Application")
Set myNS = myOutlook.GetNamespace("MAPI")

For j = 1 To myNS.Folders.Count
Set MyFolder = myNS.Folders.Item(j)
If InStr(MyFolder.Name, "Mailbox - ") <> 0 Then
MailboxName = MyFolder.Name
Call RecurseFolder(MyFolder, MailboxName)
End If
Next j

frmOutlookFolders.lstOutlookFolders.ListIndex = 0
frmOutlookFolders.lstOutlookFolders.Selected(0) = True
frmOutlookFolders.Show
End Sub
Function RecurseFolder(ByVal Thisfolder As Outlook.MAPIFolder, ByVal mbname
As String) As Long
Dim myInnerFolder As Outlook.MAPIFolder
Dim myTotal As Long, i As Long

myTotal = 1
On Error Resume Next
'Do not display deleted items folder in listing
If Thisfolder.Folders.Count > 0 And Thisfolder.Name <> "Deleted Items"
Then
For i = 1 To Thisfolder.Folders.Count
Set myInnerFolder = Thisfolder.Folders.Item(i)
If myInnerFolder.DefaultItemType = olContactItem Then
If Err.Number <> 0 Then
Err.Clear
Else
' If myInnerFolder.Name = "Contacts" Then
frmOutlookFolders.lstOutlookFolders.AddItem
myInnerFolder.Name & " - " & mbname
' Else
' frmOutlookFolders.lstOutlookFolders.AddItem
myInnerFolder.Name
' End If
frmOutlookFolders.lstInvisOutlookFolders.AddItem
myInnerFolder.EntryID
End If
End If
myTotal = myTotal + RecurseFolder(myInnerFolder, mbname)
Next i
End If
RecurseFolder = myTotal

End Function
 
Top