' CI is for ContactInfo
Enum CI
First
Last
Email
Company
JobTitle
WorkPhone
HomePhone
CellPhone
WorkFax
WorkAddress
WorkCity
WorkState
WorkZip
WorkCountry
WebPage
Comments
End Enum
' Each field map item maps between a field
' name in the Access table and a property
' name Access maps to Outlook and SharePoint
' contact field info.
Type FieldMap
prop As String
Field As String
End Type
' This Varible lists all the proeprties that
' can be mapped to Contact info. You fill
' it with the corresponding field names from
' your table.
Dim Map(CI.Comments) As FieldMap
Public Sub MakeContacts()
Dim strTable As String
Dim fm As FieldMap
Dim td As dao.TableDef
Dim db As dao.Database
Dim I As Integer
' -----------------------------------------------
' UPDATE THESE STRINGS
' to match the table and field names in
' your app. It is okay not to set some if you
' don't have an equivalent.
' Set this to your table name
strTable = "Customers"
' Set these to your field names
Map(CI.First).Field = "First Name"
Map(CI.Last).Field = "Last Name"
Map(CI.Email).Field = "E-mail Address"
Map(CI.Company).Field = "Company"
Map(CI.JobTitle).Field = "Job Title"
Map(CI.WorkPhone).Field = "Business Phone"
Map(CI.HomePhone).Field = "Home Phone"
Map(CI.CellPhone).Field = "Mobile Phone"
Map(CI.WorkFax).Field = "Fax Number"
Map(CI.WorkAddress).Field = "Address"
Map(CI.WorkCity).Field = "City"
Map(CI.WorkState).Field = "State/Province"
Map(CI.WorkZip).Field = "Zip/Postal Code"
Map(CI.WorkCountry).Field = "Country/Region"
Map(CI.WebPage).Field = "Web Page"
Map(CI.Comments).Field = "Notes"
' END OF STRINGS TO UPDATE
' -----------------------------------------------
' This the code to mark fields in
' your local table with the correct
' Outlook and SharePoint field names.
'
' You shouldn't need to change this.
SetupContactProps
Set db = CurrentDb
Set td = db.TableDefs(strTable)
' Set the table level property that tells Access
' this is a Contact table.
SetProp td, "WSSTemplateID", dbInteger, 105
' For each mapped field, set the correct
' contacts property.
For I = 0 To CI.Comments
fm = Map(I)
If Len(fm.Field) > 0 Then
SetProp td.Fields(fm.Field), "WSSFieldID", dbText, fm.prop
End If
Next
End Sub
' This code initializes the contact property
' names that Access uses to map contact info
' to SharePoint or Outlook.
'
' You shouldn't need to change this.
Sub SetupContactProps()
Map(CI.First).prop = "FirstName"
Map(CI.Last).prop = "Title"
Map(CI.Email).prop = "Email"
Map(CI.Company).prop = "Company"
Map(CI.JobTitle).prop = "JobTitle"
Map(CI.WorkPhone).prop = "WorkPhone"
Map(CI.HomePhone).prop = "HomePhone"
Map(CI.CellPhone).prop = "CellPhone"
Map(CI.WorkFax).prop = "WorkFax"
Map(CI.WorkAddress).prop = "WorkAddress"
Map(CI.WorkCity).prop = "WorkCity"
Map(CI.WorkState).prop = "WorkState"
Map(CI.WorkZip).prop = "WorkZip"
Map(CI.WorkCountry).prop = "WorkCountry"
Map(CI.WebPage).prop = "WebPage"
Map(CI.Comments).prop = "Comments"
End Sub
' This is a helper routine which sets a property
' value first checking to see whether one already
' exists.
Sub SetProp(o As Object, strProp As String, dbType As DataTypeEnum, oValue As Variant)
Dim p As dao.Property
On Error GoTo NotFound
Set p = o.Properties(strProp)
GoTo Found
NotFound:
Set p = CurrentDb.CreateProperty(strProp, dbType, oValue)
o.Properties.Append p
Found:
If p.Type = dbType Then
p.Value = oValue
Else
o.Properties.Delete (strProp)
Set p = CurrentDb.CreateProperty(strProp, dbType, oValue)
End If
.