Solved: Importing Contacts from Address Book

[nolan]

Hi there,

I'm new to writing VBA in outlook, and am consequently not familiar at all with the object model.

I'm trying to write a routine to
1. Delete all contacts in the default contacts folder where the companyName property = X

2. Copy all contacts from the address book to the default contacts folder where the company name of that contact = x

I have an idea how to to delete existing contacts:

Sub DisplayContact()
Dim myOutlook As Outlook.Application
Dim myInformation As NameSpace
Dim myContacts As Items
Dim myItems As ContactItem

Set myOutlook = CreateObject("Outlook.Application")
Set myInformation = myOutlook.GetNamespace("MAPI")
Set myContacts = myInformation.GetDefaultFolder(olFolderContacts).Items

For Each myItems In myContacts
MsgBox (myItems.FirstName)
If myItems.CompanyName = "My Company" Then
myItems.Delete
End If
Next
End Sub

but I'm totally stumped as to how I might selectively import contacts from the address book though VBA.

Any help would be greatly appreciated!

Nolan

[nolan]

I have used the following code to selectively delete contacts:


Dim myContactsFolder As Folder
Dim myOutlook As Outlook.Application
Dim myInformation As NameSpace
Dim myItems As Outlook.Items
Dim thisContact As ContactItem

Set myOutlook = CreateObject("Outlook.Application")
Set myInformation = myOutlook.GetNamespace("MAPI")
Set myContactsFolder = myInformation.GetDefaultFolder(olFolderContacts)
Set myItems = myContactsFolder.Items

On Error Resume Next
For i = myItems.Count To 1 Step -1
If myItems(i).CompanyName = "something" Then
myItems(i).Delete
End If
Next i
On Error GoTo 0
End If

and this code is at least getting me close to retrieving contacts from the GAL to selectively copy them:

Dim outApp As Object, outNS As Outlook.NameSpace
Dim mtxAddressList As Outlook.AddressList
Dim mtxGALEntries As AddressEntries
Dim mtxGALEntry As AddressEntry
Dim thisContact As ContactItem
Set outApp = CreateObject("Outlook.Application")
Set outNS = outApp.GetNamespace("MAPI")
Set mtxAddressList = outNS.session.AddressLists("Global Address List")
Set mtxGALEntries = mtxAddressList.AddressEntries

For Each mtxGALEntry In mtxGALEntries
'Test if this record is from sync
Set thisContact = mtxGALEntry.GetContact
MsgBox thisContact.FirstName
Next mtxGALEntry
Set outApp = Nothing

I'm still having touble with an error in the code, but will cover that question in a seperate post.