This example shows how you can manipulate your Outlook Contacts using
VBScript.
'
' This script implements all the necessary functions for accessing
' the Contacts register in MS Outlook.
' Assumes that the number of entries in contact folder is constant for the run
set ol = CreateObject ("Outlook.Application")
set ns = ol.GetNameSpace ("MAPI")
set contacts = ns.getDefaultFolder (10)
counter = 1
sub selectEntries()
counter = 1
end sub
sub getNextEntry ()
' Non-contact to skip?
' 40 is contacts item, 69 is distribution list
do while (counter <= contacts.Items.count) and (contacts.Items.Item(counter).Class <> 40)
counter = counter + 1 ' skipping non contact elements
loop
'End of items?
if (counter > contacts.Items.count) then
result.setStatus 0
result.setMessage "End of input"
exit sub
end if
' Where here know that we have a legal contact
populateEntry entry, contacts.Items.Item(counter)
' Increase current position
counter = counter + 1
end sub
sub modEntry ()
flt = "[" & search.getFirstCriteriaName() & "] = '" & search.getFirstCriteriaValue() & "'"
set item = contacts.Items.Find ( flt )
if item is nothing then
result.setStatus 2
result.setMessage "Not found"
exit sub
end if
populateItem entry, item
item.Save
end sub
sub deleteEntry ()
flt = "[" & search.getFirstCriteriaName() & "] = '" & search.getFirstCriteriaValue() & "'"
set item = contacts.Items.Find ( flt )
if item is nothing then
result.setStatus 2
result.setMessage "Not found"
exit sub
end if
item.Delete
end sub
sub findEntry ()
flt = "[" & search.getFirstCriteriaName() & "] = '" & search.getFirstCriteriaValue() & "'"
set item = contacts.Items.Find ( flt )
if item is nothing then
result.setStatus 2
result.setMessage "Not found" + "\n --->["& flt & "]"
else
populateEntry entry, item
end if
end sub
sub putEntry ()
set item = contacts.Items.Add
if item is nothing then
result.setStatus 2
result.setMessage "Unabled to create olContacts(2) item"
exit sub
end if
populateItem entry, item
item.Save
end sub
sub populateEntry (entry, item)
entry.setAttribute "FullName", item.FullName
entry.setAttribute "Email1Address", item.Email1Address
entry.setAttribute "Categories", item.Categories
entry.setAttribute "Birthday", item.Birthday
entry.setAttribute "LastModificationTime", item.LastModificationTime
entry.setAttribute "BusinessAddress", item.BusinessAddress
entry.setAttribute "BusinessTelephoneNumber", item.BusinessTelephoneNumber
entry.setAttribute "BusinessFaxNumber", item.BusinessFaxNumber
entry.setAttribute "HomeAddress", item.HomeAddress
entry.setAttribute "HomeTelephoneNumber", item.HomeTelephoneNumber
entry.setAttribute "HomeFaxNumber", item.HomeFaxNumber
entry.setAttribute "MobileTelephoneNumber", item.MobileTelephoneNumber
entry.setAttribute "JobTitle", item.JobTitle
end sub
sub populateItem (entry, item)
item.FullName = entry.getString("FullName")
item.FileAs = entry.getString("FullName")
end sub