Creating and updating Microsoft Outlook contacts using Visual FoxPro 8 from a table
Back to Visual FoxPro
I have spent many hours trying to work out how to use the Outlook object. This is a result of many hours, hopefully it can help with yours. It is more a guide than a total solution. Please email me with any queries
#DEFINE olFolderContacts 10
#DEFINE olCurrency 14
#DEFINE olPercent 12
*I use this a lot below so create a define for it
#define cr CHR(13)+CHR(10)
LOCAL loOutlook, loNameSpace, loFolder, loContact, loNewContact, lcSurname, ;
lcMacro, lcMacroWith, lcMacroEndWith
ON ERROR do errorhandler WITH ;
ERROR( ), MESSAGE( ), MESSAGE(1), PROGRAM( ), LINENO( )
CLOSE DATA ALL
USE "lcf.dbf"
loOutlook = CREATE("Outlook.Application")
loNamespace = loOutlook.GetNameSpace("MAPI")
loContact = loNameSpace.GetDefaultFolder(olFolderContacts)
lnNewContact = 0
lnExistingContact = 0
SELECT lcf
SCAN
ThisForm._progressbar1.update(RECNO()/RECCOUNT()*100)
*Remove ' from the surname or you get an OLE error
lcSurname = CHRTRAN(lcf.surname, "'", " ")
*Create a macro for searching
lcMacro = "[lastname]='" + ALLTRIM(lcSurname) + "' and [firstname]='" +;
ALLTRIM(lcf.first_name) + "'"
*Find the contact using surname and first name
ofind = loContact.items.find(lcMacro)
IF !ISNULL(ofind)
*We have found a contact
lnExistingContact = lnExistingContact + 1
*So start replacing
WITH ofind
.categories = "LCF Database - Updated contact"
.homeaddress = IIF(!EMPTY(lcf.building),ALLTRIM(lcf.building)+cr,"") +;
ALLTRIM(lcf.street) + cr + ;
IIF(!EMPTY(lcf.place),ALLTRIM(lcf.place) + cr ,"" ) +;
ALLTRIM(lcf.town) + cr + ;
ALLTRIM(lcf.county) + cr + ;
ALLTRIM(lcf.post_code)
.CompanyName = lcf.firm
.businessaddress = IIF(!EMPTY(lcf.w_building),ALLTRIM(lcf.w_building)+cr,"") +;
ALLTRIM(lcf.w_street) + cr + ;
IIF(!EMPTY(lcf.w_place),ALLTRIM(lcf.w_place) + cr ,"" ) +;
ALLTRIM(lcf.w_town) + cr + ;
ALLTRIM(lcf.w_county) + cr + ;
ALLTRIM(lcf.w_post_cod)
IF UPPER(lcf.mailing) = "HOME"
*Set home address as mailing address
.selectedmailingaddress = 1
*set the email addresses
IF !EMPTY(lcf.homeemail)
.email1address = ALLTRIM(lcf.homeemail)
IF !EMPTY(lcf.w_email)
.email2address = ALLTRIM(lcf.w_email)
ENDIF
ELSE
IF !EMPTY(lcf.w_email)
.email1address = ALLTRIM(lcf.w_email)
ENDIF
ENDIF
ELSE
*Set work address as mailing address
.selectedmailingaddress = 2
IF !EMPTY(lcf.w_email)
.email1address = ALLTRIM(lcf.w_email)
IF !EMPTY(lcf.homeemail)
.email2address = ALLTRIM(lcf.homeemail)
ENDIF
ELSE
IF !EMPTY(lcf.homeemail)
.email1address = ALLTRIM(lcf.homeemail)
ENDIF
ENDIF
ENDIF
.homeTelephoneNumber = ALLTRIM(lcf.home_telep)
.HomeFaxNumber = ALLTRIM(lcf.home_fax_n)
.BusinessTelephoneNumber = ALLTRIM(lcf.work_telep)
.BusinessFaxNumber = ALLTRIM(lcf.work_fax_n)
.mobileTelephoneNumber = ALLTRIM(lcf.mobile_dir)
*Save the changes
.Save
ENDWITH
ELSE
*Have not found a contact so use the following to add a new one
loNewContact = loContact.Items.Add() && Returns an object of type
&& ContactItem
WITH loNewContact
.title = ALLTRIM(lcf.title)
.initials = ALLTRIM(lcf.initials)
.lastname = ALLTRIM(lcf.surname)
.firstname = ALLTRIM(lcf.first_name)
.categories = "LCF Database - New contact"
.homeaddress = IIF(!EMPTY(lcf.building),ALLTRIM(lcf.building)+cr,"") +;
ALLTRIM(lcf.street) + cr + ;
IIF(!EMPTY(lcf.place),ALLTRIM(lcf.place) + cr ,"" ) +;
ALLTRIM(lcf.town) + cr + ;
ALLTRIM(lcf.county) + cr + ;
ALLTRIM(lcf.post_code)
.CompanyName = lcf.firm
.businessaddress = IIF(!EMPTY(lcf.w_building),ALLTRIM(lcf.w_building)+cr,"") +;
ALLTRIM(lcf.w_street) + cr + ;
IIF(!EMPTY(lcf.w_place),ALLTRIM(lcf.w_place) + cr ,"" ) +;
ALLTRIM(lcf.w_town) + cr + ;
ALLTRIM(lcf.w_county) + cr + ;
ALLTRIM(lcf.w_post_cod)
IF UPPER(lcf.mailing) = "HOME"
*Set home address as mailing address
.selectedmailingaddress = 1
*set the email addresses
IF !EMPTY(lcf.homeemail)
.email1address = ALLTRIM(lcf.homeemail)
IF !EMPTY(lcf.w_email)
.email2address = ALLTRIM(lcf.w_email)
ENDIF
ELSE
IF !EMPTY(lcf.w_email)
.email1address = ALLTRIM(lcf.w_email)
ENDIF
ENDIF
ELSE
*Set work address as mailing address
.selectedmailingaddress = 2
IF !EMPTY(lcf.w_email)
.email1address = ALLTRIM(lcf.w_email)
IF !EMPTY(lcf.homeemail)
.email2address = ALLTRIM(lcf.homeemail)
ENDIF
ELSE
IF !EMPTY(lcf.homeemail)
.email1address = ALLTRIM(lcf.homeemail)
ENDIF
ENDIF
ENDIF
.homeTelephoneNumber = ALLTRIM(lcf.home_telep)
.HomeFaxNumber = ALLTRIM(lcf.home_fax_n)
.BusinessTelephoneNumber = ALLTRIM(lcf.work_telep)
.BusinessFaxNumber = ALLTRIM(lcf.work_fax_n)
.mobileTelephoneNumber = ALLTRIM(lcf.mobile_dir)
*Save the changes
.Save
lnNewContact = lnNewContact + 1
ENDWITH
ENDIF
ENDSCAN
MESSAGEBOX("New contacts = " + STR(lnNewContact) + CHR(13) + CHR(10) + ; "Existing contacts = " + STR(lnExistingContact),64,"Contact Import")
ON ERROR
CLOSE DATA ALL