*
Metamerge logo
Search

Advanced Search
*
*
*
* HOME DOCUMENTS & RESOURCES DOWNLOADS EARLY TECH ACCESS SUPPORT FAQ KNOWN ISSUES OLD VERSIONS
*

Sample: VBScript Connector

Overview

This example shows how you can manipulate your Outlook Contacts using VBScript.

Sample Code

'
' 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

See Also

Script Connector

 
*
  Metamerge Integrator version 4.5 ©Copyright Metamerge AS 2000-2002 Last edited 2002-04-30 contact us