Keeping Outlook contacts updated from a local/web mysql DB

Yes it is... I am not sure if you know much about VB... If you do, what I did is I created a Macro that runs when outlook opens and does the sync...  There isn't an easy way other than this to do it. Unless you have an Exchange Server.

The macro uses an ODBC connection to the database...

The macro runs when Outlook is opened... One ran the macro removes all contacts from the contacts folder sending them to the trash... Then the macro pulls the contacts from the database to Outlook and basically recreats the contacts....  I can post a copy of my script for you to look at or use but it is very difficault to set up unless you have experiance with: ODBC, ADO, VB, Digital Signatures, and Databases...

Hey Delta,

If you could post it I would appreciate it, just so I know what I am up against!

I don't know VB all that well, but I am a little familiar with it, so it would be good to see roughly what I need to do.

Thanks for your help delta!

Cheers,

MIKE

The script is between the dashed lines. Sorry but I was on a time crunch when I wrote it originally so the programming is sloppy. At the time I just needed to get it to work, and it does work. We have been using it on the computers at my Job for about a year now and haven't had many problems with it. I also built a program to allow a contact administrator to control what contacts are put into the Database but it is very DB specific and is compiled code so I will not be able to give you an example of that but address can be added directly into the database manually without it. The program just made is so easy that anyone with the program could add contacts.

Here is the Outlook Sync Script:
---------------------------------------------------------------------------------------------
'VARs here are for ADO conn to database
Dim connDB As ADODB.Connection
Dim rsContact As ADODB.Recordset
Const MY_DATABASE = "DSN=GlobalAddress"

Private Sub RemoveContacts() 'This sub removes all contacts from folder

'DIM of Vars
Dim OA As New Outlook.Application        ' Outlook Application
Dim ONS As Outlook.NameSpace             ' Outlook Namespace.
Dim ContactFolder As MAPIFolder          ' Contact folder.
Dim AContact As Outlook.ContactItem      ' Contact Item
Dim ErrCount As Integer

On Error GoTo dastart
GoTo damain

dastart: 'This gets skipped unless error happens
    On Error Resume Next
    ErrCount = 1311 'This could be changed to boolean not sure why I did this

damain: 'Unless error program starts here
    'This gets you to the Outlook Mailbox
    Set ONS = OA.GetNamespace("MAPI")
   
    'This gets a reference to your Contacts folder
    Set ContactFolder = ONS.GetDefaultFolder(olFolderContacts)
 
    'Removing the contacts from the folder
    Set AContact = ContactFolder.Items.GetFirst
    Do Until ContactFolder.Items.Count = 0
        If ContactFolder.Items.Count = 1 Then
            ContactFolder.Items.GetFirst
        End If
        ContactFolder.Items.Remove (1)
        ContactFolder.Items.GetNext
    Loop
    'All items are now removed
 
    ' Always good to clean house and deallocate memory associated with these objects
    Set AContact = Nothing
    Set ContactFolder = Nothing
    Set ONS = Nothing
    Set OA = Nothing

    If ErrCount = 1311 Then
        MsgBox "There may have been an error removing your old contacts... Please contact a network admin to have the problem corrected.", vbExclamation
    End If

End Sub


Private Sub AddContacts() 'This sub adds contacts to the folder

'DIM of Vars
Dim OA As New Outlook.Application          ' Outlook Application
Dim ONS As Outlook.NameSpace               ' Outlook Namespace
Dim ContactFolder As MAPIFolder            ' Contact folder
Dim ContactItem1 As Outlook.ContactItem    ' Contact Item
   
On Error GoTo ErrorRtn
   
' This gets you to the Outlook Mailbox
Set ONS = OA.GetNamespace("MAPI")
   
' This gets a reference to your Contacts folder
Set ContactFolder = ONS.GetDefaultFolder(olFolderContacts)
 
' Checking RecordSet Status
If rsContact.State <> adStateOpen Then GoTo ExitRtn
   
' Move to the first record
rsContact.MoveFirst
While Not rsContact.EOF
    Set ContactItem1 = Nothing
       
    ' This adds a new contact item to the contact folder
    Set ContactItem1 = ContactFolder.Items.Add(olContactItem)
       
    ' Now, set whatever contact item values you want to from your database
    ' I always append an empty string in case the database value is null
    '(otherwise you'll get a type mismatch)
    ContactItem1.FirstName = rsContact("FirstName").Value & ""
    ContactItem1.LastName = rsContact("LastName").Value & ""
    ContactItem1.Title = rsContact("Title").Value & ""
    ContactItem1.MiddleName = rsContact("MiddleName").Value & ""
    ContactItem1.BusinessTelephoneNumber = rsContact("BusinessPhone").Value & ""
    ContactItem1.Business2TelephoneNumber = rsContact("BusinessPhone2").Value & ""
    ContactItem1.CompanyName = rsContact("Company").Value & ""
    ContactItem1.Department = rsContact("Department").Value & ""
    ContactItem1.JobTitle = rsContact("JobTitle").Value & ""
    ContactItem1.HomeTelephoneNumber = rsContact("HomePhone").Value & ""
    ContactItem1.HomeFaxNumber = rsContact("HomeFax").Value & ""
    ContactItem1.MobileTelephoneNumber = rsContact("MobilePhone").Value & ""
    ContactItem1.PagerNumber = rsContact("Pager").Value & ""
    ContactItem1.Email1Address = rsContact("EmailAddress").Value & ""
    ContactItem1.Email1AddressType = rsContact("EmailType").Value & ""
       
    ' Now, save the contact to the Outlook contact list
    ContactItem1.Save
   
    ' Move to the next database record
    rsContact.MoveNext
Wend 'Part of the while loop from above


ExitRtn:
' Always good to clean house and deallocate memory associated with these objects
   Set ContactItem1 = Nothing
   Set ContactFolder = Nothing
   Set ONS = Nothing
   Set OA = Nothing
   Exit Sub

ErrorRtn: 'This only get used if Error
   
   MsgBox Err.Number & "-" & Err.Description
   
   Resume ExitRtn

    ' Always good to clean house and deallocate memory associated with these objects
   Set ContactItem1 = Nothing
   Set ContactFolder = Nothing
   Set ONS = Nothing
   Set OA = Nothing
   Exit Sub

End Sub

Private Sub Application_Startup()
Dim MyFolder As Outlook.MAPIFolder
Dim myNameSpace As Outlook.NameSpace

' This requires that you set Program|References for:
' Microsoft Active Data Objects (v2.5)
' Microsoft Outlook Object Library (v9)

On Error GoTo ErrorHandler

' Create a connection to the database.
Set connDB = CreateObject("ADODB.Connection")

'Open Database
With connDB
    .ConnectionString = MY_DATABASE
    .CursorLocation = adUseClient
    .Open
End With

' Open a recordset to the Contact table of the GlobalAddress database
Set rsContact = connDB.Execute("Select * from Contacts")

'Setting info for working with folders
Set myOlApp = CreateObject("Outlook.Application")
Set myNameSpace = myOlApp.GetNamespace("MAPI")

'Changing error handeling so if folder dosn't exist it doesn't end the program
On Error GoTo addf 'Basically saying if nothing to remove start adding contacts

RemoveContacts 'Created sub to remove contacts

addf: 'Skip around for there being no contacts

On Error GoTo ErrorHandler

AddContacts 'this is a created sub to add contacts

' On the way out, close everything and deallocate their memory
Set myOlApp = Nothing
Set myNameSpace = Nothing
Set rsContact = Nothing
Set connDB = Nothing
Exit Sub

ErrorHandler: 'Only do if there is an error
    On Error GoTo endofsub
    MsgBox "Papiotrade Contacts could not be updated!", vbExclamation
   
    'close any open files and destroy VARS
   
    Set myOlApp = Nothing
    Set myNameSpace = Nothing

   
    connDB.Close
    Set connDB = Nothing
    If rsContact.State = adStateOpen Then
        rsContact.Close
    End If
    Set rsContact = Nothing

endofsub:
End Sub

---------------------------------------------------------------------------------------------

Hope you can make use of it.

Thats sweet delta! Thanks!

Is there a way to get it to work the other way around also? So, if someone updates a contact in outlook, it updates the DB?

May be a tall order..

Many, many thanks Delta, you have been a wonderful help.

Have a great weekend!

Mike

Thanks... You have a great weekend also.