Synchronise Access Database and outlook contact

[hdesbiens]

Hi

here's my problem

i have linked tables in access that point to the outlook contacts database, and every changes or new records that i do in outlook appears in my linked tables in access, but my problem is that if i add a contact in the linked tables in access it does'nt appears in outlook.

I am creating this tables cause i want to create a forms in access to enter complementary information about a contact like financial information.

Is there a way to synchronise on the two way sense not only from outlook to access but from access to outlook too???

cans someone give me a hint on how to do that

Thanks

 

[sostek]

It's all done from Outlook if I'm not mistaken. Just make the connection to the db and bring the field into the appropriate fields on Outlook.

I did a sample of this for someone. I'll see if I can dig it up.

 

[bdunlavy]

I'm having the same issue. Went through all the work of creating unique ids and creating records in the PST file from access. Record appears to be valid in access however in outlook in shows up as an email. Weird. Looking forward to help through this one. Contact updates from access work well when the record originated in outlook

 

[neilabbott]

I battled with this problem for a long time and was about to give up when I discovered "TabTag" (

http://www.tabtag.com)-

It is free for single user.
It exposes (?) an SQLview set of tables which you can link to Access (and any other SQL-system). The tables are hot-wired into Outlook and expose every Outlook field (and more)
Tabtag's table setups and relationships are exactly to their own liking and functionality but I have gotten the basic name/address stuff in a query to use easily within Access.
THe problems of unique IDs for OL contacts is solved by Tabtag and easily hooked into your own queries, combos etc
So you can now avoid that complex coding/ADO stuff and update/use OL data within your Access dbase.

The only downside is that contacts need to be in the tabtag folders - so you need all that Mapifolder stuff - but I'll work it out(!) eventually (the folder stuff)
Tabtag get their $$ from the multi-user versions.
I'd be interested to hear anyone's comments after trying/using it.
Neil

 

[oharab]

There was an article in a recent SmartAccess (

http://www.pinpub.com)

about this. I'd advise anyone to get hold of this publication. I'll try and dig it out and see if it helps.

Ben

----------------------------------------------
Ben O'Hara

http://www.RobotParade.co.uk

"Where are all the stupid people from...
...And how'd they get so dumb?"

NoFX-The Decline
----------------------------------------------
Want to get great answers to your Tek-Tips questions? Have a look at F

 

[bdunlavy]

Found out that a record entered via access with the Outlook Contact table linked will not show up in Outlook as an contact unless you force its class (shows as an email). The below code shows a simple way to ensure all records are converted to use the correct form in Outlook. No advise affect on underlaying data. You may want to limit the code to update only the new record entered if you have alot of data in your Outlook Contacts Folder.

Public Sub change_class()
Set ContactFolder = Outlook.Application.GetNamespace("MAPI").Folders("Outcome db").Folders("Contacts")

For Each contact In ContactFolder.Items

If contact.MessageClass <> "IPM.Contact" Then
contact.MessageClass = "IPM.Contact"
contact.Save
End If

Next

End Sub

 

[neilabbott]

I'm no expert by any means but what if someone keeps notes or tasks in their contacts folder?
Neil

 

[bdunlavy]

You're right - that code was to generic. This code will only change the record that was last entered that you know is a contact record.

Public Sub FindContact_change_class()

Dim ol As New Outlook.Application
Dim ns As Outlook.NameSpace
Dim fdContacts As Outlook.MAPIFolder
Dim itmsContacts As Outlook.Items
Dim itm As Object
Dim criteria As String

Set ns = ol.GetNamespace("MAPI")
Set fdContacts = ns.Folders("Outcome db").Folders("Contacts")
Set itmsContacts = fdContacts.Items

criteria = "[User4] = """ & Forms![frm_master]![frm_contacts].Form![Contact ID Outlook] & """"
Set itm = itmsContacts.Find(criteria)

If itm Is Nothing Then
MsgBox "Unable to locate the item."
Else
itm.MessageClass = "IPM.Contact"
itm.Save

End If

End Sub

 

[neilabbott]

I spoke too soon about the TabTag SQL stuff.
Their unique IDs are GUIDs... and thus almost impossible to use in criteria statements where you want to tack on something like "Select XYZ from QWERTY where SomeField = " & " 'variable'" .
All that apostrophe double quote ampersand malarkey is a real pain...

GUIDs appear as strings but aren't etc etc!

 

[MichaelRed]

" ... SmartAccess (

http://www.pinpub.com)

... "

... but to view anything (useful) you need to be in the "Paid suscriber" category ...




MichaelRed

 

[MichaelRed]

At the risk of being a bit verbose:

Option Compare Database
Option Explicit
Public Function basContactsToTable()

    Dim dbs As DAO.Database
    Dim rst As DAO.Recordset

    Dim olApp As Outlook.Application
    Dim objNameSpace As NameSpace
    Dim objContacts As MAPIFolder
    Dim objSubFolder As MAPIFolder
    Dim objContactItem As ContactItem
    Dim strFolderName As String
    Dim lngCount As Long
    Dim FieldNames() As String
    Dim strFieldName As String

    Dim Idx As Integer          'Subfolder (Just to wend our way their)
    Dim Jdx As Integer          'Individual Contact
    Dim Kdx As Integer          'Property (of / from the Contact)
    Dim Ldx As Integer          'Field of the New record to test for fill In

    'Just a slight of hand to avoid the individual declaration of the _
     Contact Item Properties and their associated field names (in our new table)
    FieldNames() = basDeclFieldNames(FieldNames())

    Set dbs = CurrentDb
    Set rst = dbs.OpenRecordset("tblContacts", dbOpenDynaset)

    Idx = 1         'Idx is the "Folder" pointer
    Set olApp = CreateObject("Outlook.Application")
    Set objNameSpace = olApp.GetNamespace("MAPI")
    Set objContacts = objNameSpace.GetDefaultFolder(olPublicFoldersAllPublicFolders)
    For Each objSubFolder In objContacts.Folders
        strFolderName = objSubFolder.Name
        Debug.Print objSubFolder.Name
        If (strFolderName = "Common Contacts") Then
            Kdx = 1
            While Kdx <= objSubFolder.Items.Count
                Set objContactItem = objSubFolder.Items(Kdx)    'Kdx = Specific Contact
                rst.AddNew
                    Jdx = 0                                     'Jdx = Property/Field index
                    Do While Jdx <= UBound(FieldNames)
                        strFieldName = objContactItem.ItemProperties(Jdx).Name
                        On Error Resume Next
                        rst(strFieldName) = objContactItem.ItemProperties(Jdx)
                        On Error GoTo 0
                        Jdx = Jdx + 1
                        DoEvents
                    Loop
                rst.Update
                'reset object to get next item
                Set objContactItem = Nothing
                Kdx = Kdx + 1
            Wend
            DoEvents
            Idx = Idx + 1
        End If
    Next                'objSubFolder

    Set objContacts = Nothing
    Set objNameSpace = Nothing
    Set olApp = Nothing

End Function
Public Function basDeclFieldNames(FieldNames() As String) As String()

    Dim strFieldName(200) As String
    Dim strTemp() As String
    Dim Idx As Integer

    strFieldName(0) = "Categories"
    strFieldName(1) = "Mileage"
    strFieldName(2) = "UserProperties"
    strFieldName(3) = "Account"
    strFieldName(4) = "Anniversary"
    strFieldName(5) = "AssistantName"
    strFieldName(6) = "AssistantTelephoneNumber"
    strFieldName(7) = "Birthday"
    strFieldName(8) = "Business2TelephoneNumber"
    strFieldName(9) = "BusinessAddress"
    strFieldName(10) = "BusinessAddressCity"
    strFieldName(11) = "BusinessAddressCountry"
    strFieldName(12) = "BusinessAddressPostalCode"
    strFieldName(13) = "BusinessAddressPostOfficeBox"
    strFieldName(14) = "BusinessAddressState"
    strFieldName(15) = "BusinessAddressStreet"
    strFieldName(16) = "BusinessFaxNumber"
    strFieldName(17) = "BusinessHomePage"
    strFieldName(18) = "BusinessTelephoneNumber"
    strFieldName(19) = "CallbackTelephoneNumber"
    strFieldName(20) = "CarTelephoneNumber"
    strFieldName(21) = "Children"
    strFieldName(22) = "CompanyAndFullName"
    strFieldName(23) = "CompanyLastFirstNoSpace"
    strFieldName(24) = "CompanyLastFirstSpaceOnly"
    strFieldName(25) = "CompanyMainTelephoneNumber"
    strFieldName(26) = "CompanyName"
    strFieldName(27) = "ComputerNetworkName"
    strFieldName(28) = "CustomerID"
    strFieldName(29) = "Department"
    strFieldName(30) = "Email1Address"
    strFieldName(31) = "Email1AddressType"
    strFieldName(32) = "Email1DisplayName"
    strFieldName(33) = "Email1EntryID"
    strFieldName(34) = "Email2Address"
    strFieldName(35) = "Email2AddressType"
    strFieldName(36) = "Email2DisplayName"
    strFieldName(37) = "Email2EntryID"
    strFieldName(38) = "Email3Address"
    strFieldName(39) = "Email3AddressType"
    strFieldName(40) = "Email3DisplayName"
    strFieldName(41) = "Email3EntryID"
    strFieldName(42) = "FileAs"
    strFieldName(43) = "FirstName"
    strFieldName(44) = "FTPSite"
    strFieldName(45) = "FullName"
    strFieldName(46) = "FullNameAndCompany"
    strFieldName(47) = "Gender"
    strFieldName(48) = "GovernmentIDNumber"
    strFieldName(49) = "Hobby"
    strFieldName(50) = "Home2TelephoneNumber"
    strFieldName(51) = "HomeAddress"
    strFieldName(52) = "HomeAddressCity"
    strFieldName(53) = "HomeAddressCountry"
    strFieldName(54) = "HomeAddressPostalCode"
    strFieldName(55) = "HomeAddressPostOfficeBox"
    strFieldName(56) = "HomeAddressState"
    strFieldName(57) = "HomeAddressStreet"
    strFieldName(58) = "HomeFaxNumber"
    strFieldName(59) = "HomeTelephoneNumber"
    strFieldName(60) = "Initials"
    strFieldName(61) = "InternetFreeBusyAddress"
    strFieldName(62) = "ISDNNumber"
    strFieldName(63) = "JobTitle"
    strFieldName(64) = "Journal"
    strFieldName(35) = "Language"
    strFieldName(66) = "LastFirstAndSuffix"
    strFieldName(67) = "LastFirstNoSpace"
    strFieldName(68) = "LastFirstNoSpaceCompany"
    strFieldName(69) = "LastFirstSpaceOnly"
    strFieldName(70) = "LastFirstSpaceOnlyCompany"
    strFieldName(71) = "LastName"
    strFieldName(72) = "LastNameAndFirstName"
    strFieldName(73) = "MailingAddress"
    strFieldName(74) = "MailingAddressCity"
    strFieldName(75) = "MailingAddressCountry"
    strFieldName(76) = "MailingAddressPostalCode"
    strFieldName(77) = "MailingAddressPostOfficeBox"
    strFieldName(78) = "MailingAddressState"
    strFieldName(79) = "MailingAddressStreet"
    strFieldName(80) = "ManagerName"
    strFieldName(81) = "MiddleName"
    strFieldName(82) = "MobileTelephoneNumber"
    strFieldName(83) = "NetMeetingAlias"
    strFieldName(84) = "NetMeetingServer"
    strFieldName(85) = "NickName"
    strFieldName(86) = "OfficeLocation"
    strFieldName(87) = "OrganizationalIDNumber"
    strFieldName(88) = "OtherAddress"
    strFieldName(89) = "OtherAddressCity"
    strFieldName(90) = "OtherAddressCountry"
    strFieldName(91) = "OtherAddressPostalCode"
    strFieldName(92) = "OtherAddressPostOfficeBox"
    strFieldName(93) = "OtherAddressState"
    strFieldName(94) = "OtherAddressStreet"
    strFieldName(95) = "OtherFaxNumber"
    strFieldName(96) = "OtherTelephoneNumber"
    strFieldName(97) = "PagerNumber"
    strFieldName(98) = "PersonalHomePage"
    strFieldName(99) = "PrimaryTelephoneNumber"
    strFieldName(100) = "Profession"
    strFieldName(101) = "RadioTelephoneNumber"
    strFieldName(102) = "ReferredBy"
    strFieldName(103) = "SelectedMailingAddress"
    strFieldName(104) = "Spouse"
    strFieldName(105) = "Suffix"
    strFieldName(106) = "TelexNumber"
    strFieldName(107) = "Title"
    strFieldName(108) = "TTYTDDTelephoneNumber"
    strFieldName(109) = "User1"
    strFieldName(110) = "User2"
    strFieldName(111) = "User3"
    strFieldName(112) = "User4"
    strFieldName(113) = "UserCertificate"
    strFieldName(114) = "WebPage"
    strFieldName(115) = "YomiCompanyName"
    strFieldName(116) = "YomiFirstName"
    strFieldName(117) = "YomiLastName"
    strFieldName(118) = "Links"
    strFieldName(119) = "ItemProperties"
    strFieldName(120) = "LastFirstNoSpaceAndSuffix"
    strFieldName(121) = "DownloadState"
    strFieldName(122) = "IMAddress"
    strFieldName(123) = "Assistant's Name"
    strFieldName(124) = "Assistant's Phone"
    strFieldName(125) = "Check Name..."
    strFieldName(126) = "Company Flag"
    strFieldName(127) = "Contacts"
    strFieldName(128) = "E-mail 2"
    strFieldName(129) = "E-mail 3"
    strFieldName(130) = "E-mail Selected"
    strFieldName(131) = "File As"
    strFieldName(132) = "Flag Status"
    strFieldName(133) = "Home Address"
    strFieldName(134) = "Mobile Phone"
    strFieldName(135) = "PrimaryPHLocation"
    strFieldName(136) = "User Field 1"
    strFieldName(137) = "User Field 2"
    strFieldName(138) = "User Field 3"
    strFieldName(139) = "User Field 4"
    strFieldName(140) = "Companies"

    ReDim strTemp(0)
    While Idx <= UBound(strFieldName)
        If (strFieldName(Idx) <> "") Then
            strTemp(UBound(strTemp)) = strFieldName(Idx)
            ReDim Preserve strTemp(UBound(strTemp) + 1)
        End If
        Idx = Idx + 1
    Wend
    ReDim Preserve strTemp(UBound(strTemp) - 1)
    
    basDeclFieldNames = strTemp()

End Function
Public Function basMaketblContacts()

    'Create a table with all the Contacts Fields (we think are Reasonable and Vallid) _
     based on collecting the ItemProperties.

    Dim dbs As DAO.Database
    Dim rst As DAO.Recordset

    Dim tdf As TableDef
    Dim fld As Field
    Dim prp As Property

    Dim olProperty(200) As String
    Dim Jdx As Integer

'    olProperty(0) = "Application"
'    olProperty(1) = "Class"
'    olProperty(2) = "Session"
'    olProperty(3) = "Parent"
'    olProperty(4) = "Actions"
'    olProperty(5) = "Attachments"
'    olProperty(6) = "BillingInformation"
'    olProperty(7) = "Body"
    olProperty(8) = "Categories"
    olProperty(9) = "Companies"
'    olProperty(10) = "ConversationIndex"
'    olProperty(11) = "ConversationTopic"
'    olProperty(12) = "CreationTime"
'    olProperty(13) = "EntryID"
'    olProperty(14) = "FormDescription"
'    olProperty(15) = "GetInspector"
'    olProperty(16) = "Importance"
'    olProperty(17) = "LastModificationTime"
'    olProperty(18) = "MessageClass"
    olProperty(19) = "Mileage"
'    olProperty(20) = "NoAging"
'    olProperty(21) = "OutlookInternalVersion"
'    olProperty(22) = "OutlookVersion"
'    olProperty(23) = "Saved"
'    olProperty(24) = "Sensitivity"
'    olProperty(25) = "Size"
'    olProperty(26) = "Subject"
'    olProperty(27) = "UnRead"
    olProperty(28) = "UserProperties"
    olProperty(29) = "Account"
    olProperty(30) = "Anniversary"
    olProperty(31) = "AssistantName"
    olProperty(32) = "AssistantTelephoneNumber"
    olProperty(33) = "Birthday"
    olProperty(34) = "Business2TelephoneNumber"
    olProperty(35) = "BusinessAddress"
    olProperty(36) = "BusinessAddressCity"
    olProperty(37) = "BusinessAddressCountry"
    olProperty(38) = "BusinessAddressPostalCode"
    olProperty(39) = "BusinessAddressPostOfficeBox"
    olProperty(40) = "BusinessAddressState"
    olProperty(41) = "BusinessAddressStreet"
    olProperty(42) = "BusinessFaxNumber"
    olProperty(43) = "BusinessHomePage"
    olProperty(44) = "BusinessTelephoneNumber"
    olProperty(45) = "CallbackTelephoneNumber"
    olProperty(46) = "CarTelephoneNumber"
    olProperty(47) = "Children"
    olProperty(48) = "CompanyAndFullName"
    olProperty(49) = "CompanyLastFirstNoSpace"
    olProperty(50) = "CompanyLastFirstSpaceOnly"
    olProperty(51) = "CompanyMainTelephoneNumber"
    olProperty(52) = "CompanyName"
    olProperty(53) = "ComputerNetworkName"
    olProperty(54) = "CustomerID"
    olProperty(55) = "Department"
    olProperty(56) = "Email1Address"
    olProperty(57) = "Email1AddressType"
    olProperty(58) = "Email1DisplayName"
    olProperty(59) = "Email1EntryID"
    olProperty(60) = "Email2Address"
    olProperty(61) = "Email2AddressType"
    olProperty(62) = "Email2DisplayName"
    olProperty(63) = "Email2EntryID"
    olProperty(64) = "Email3Address"
    olProperty(65) = "Email3AddressType"
    olProperty(66) = "Email3DisplayName"
    olProperty(67) = "Email3EntryID"
    olProperty(68) = "FileAs"
    olProperty(69) = "FirstName"
    olProperty(70) = "FTPSite"
    olProperty(71) = "FullName"
    olProperty(72) = "FullNameAndCompany"
    olProperty(73) = "Gender"
    olProperty(74) = "GovernmentIDNumber"
    olProperty(75) = "Hobby"
    olProperty(76) = "Home2TelephoneNumber"
    olProperty(77) = "HomeAddress"
    olProperty(78) = "HomeAddressCity"
    olProperty(79) = "HomeAddressCountry"
    olProperty(80) = "HomeAddressPostalCode"
    olProperty(81) = "HomeAddressPostOfficeBox"
    olProperty(82) = "HomeAddressState"
    olProperty(83) = "HomeAddressStreet"
    olProperty(84) = "HomeFaxNumber"
    olProperty(85) = "HomeTelephoneNumber"
    olProperty(86) = "Initials"
    olProperty(87) = "InternetFreeBusyAddress"
    olProperty(88) = "ISDNNumber"
    olProperty(89) = "JobTitle"
    olProperty(90) = "Journal"
    olProperty(91) = "Language"
    olProperty(92) = "LastFirstAndSuffix"
    olProperty(93) = "LastFirstNoSpace"
    olProperty(94) = "LastFirstNoSpaceCompany"
    olProperty(95) = "LastFirstSpaceOnly"
    olProperty(96) = "LastFirstSpaceOnlyCompany"
    olProperty(97) = "LastName"
    olProperty(98) = "LastNameAndFirstName"
    olProperty(99) = "MailingAddress"
    olProperty(100) = "MailingAddressCity"
    olProperty(101) = "MailingAddressCountry"
    olProperty(102) = "MailingAddressPostalCode"
    olProperty(103) = "MailingAddressPostOfficeBox"
    olProperty(104) = "MailingAddressState"
    olProperty(105) = "MailingAddressStreet"
    olProperty(106) = "ManagerName"
    olProperty(107) = "MiddleName"
    olProperty(108) = "MobileTelephoneNumber"
    olProperty(109) = "NetMeetingAlias"
    olProperty(110) = "NetMeetingServer"
    olProperty(111) = "NickName"
    olProperty(112) = "OfficeLocation"
    olProperty(113) = "OrganizationalIDNumber"
    olProperty(114) = "OtherAddress"
    olProperty(115) = "OtherAddressCity"
    olProperty(116) = "OtherAddressCountry"
    olProperty(117) = "OtherAddressPostalCode"
    olProperty(118) = "OtherAddressPostOfficeBox"
    olProperty(119) = "OtherAddressState"
    olProperty(120) = "OtherAddressStreet"
    olProperty(121) = "OtherFaxNumber"
    olProperty(122) = "OtherTelephoneNumber"
    olProperty(123) = "PagerNumber"
    olProperty(124) = "PersonalHomePage"
    olProperty(125) = "PrimaryTelephoneNumber"
    olProperty(126) = "Profession"
    olProperty(127) = "RadioTelephoneNumber"
    olProperty(128) = "ReferredBy"
    olProperty(129) = "SelectedMailingAddress"
    olProperty(130) = "Spouse"
    olProperty(131) = "Suffix"
    olProperty(132) = "TelexNumber"
    olProperty(133) = "Title"
    olProperty(134) = "TTYTDDTelephoneNumber"
    olProperty(135) = "User1"
    olProperty(136) = "User2"
    olProperty(137) = "User3"
    olProperty(138) = "User4"
    olProperty(139) = "UserCertificate"
    olProperty(140) = "WebPage"
    olProperty(141) = "YomiCompanyName"
    olProperty(142) = "YomiFirstName"
    olProperty(143) = "YomiLastName"
    olProperty(144) = "Links"
    olProperty(145) = "ItemProperties"
    olProperty(146) = "LastFirstNoSpaceAndSuffix"
    olProperty(147) = "DownloadState"
    olProperty(148) = "IMAddress"
'    olProperty(149) = "MarkForDownload"
'    olProperty(150) = "IsConflict"
'    olProperty(151) = "AutoResolvedWinner"
'    olProperty(152) = "Conflicts"
'    olProperty(153) = "HasPicture"
    olProperty(154) = "Assistant's Name"
    olProperty(155) = "Assistant's Phone"
    olProperty(156) = "Check Name..."
    olProperty(157) = "Company Flag"
    olProperty(158) = "Contacts"
    olProperty(159) = "E-mail 2"
    olProperty(160) = "E-mail 3"
    olProperty(161) = "E-mail Selected"
    olProperty(162) = "File As"
    olProperty(163) = "Flag Status"
    olProperty(164) = "Home Address"
    olProperty(165) = "Mobile Phone"
    olProperty(166) = "PrimaryPHLocation"
    olProperty(167) = "User Field 1"
    olProperty(168) = "User Field 2"


    Set dbs = CurrentDb
    Set tdf = dbs.CreateTableDef("tblContats")

    ' Create and append new Field objects for the new
    ' TableDef object.
    With tdf
        While Jdx <= UBound(olProperty)
            If (olProperty(Jdx) <> "") Then
                .Fields.Append .CreateField(olProperty(Jdx), dbText, 255)
            End If
            Jdx = Jdx + 1
        Wend
    End With

    dbs.TableDefs.Append tdf

End Function
Public Function basIdEmptyFields()

    Dim dbs As DAO.Database
    Dim rst As DAO.Recordset
    Dim rstField As DAO.Recordset

    Dim strSQL As String
    Dim Idx As Integer
    Dim Jdx As Integer

    Set dbs = CurrentDb
    Set rst = dbs.OpenRecordset("tblContacts", dbOpenDynaset)

    While Idx <= rst.Fields.Count - 1

        strSQL = "SELECT Len(Trim([" & rst.Fields(Idx).Name & "])) AS Expr1 FROM tblContacts " _
               & "WHERE (((Len(Trim([" & rst.Fields(Idx).Name & "]))) <> 0));"
        DoCmd.SetWarnings False
        Set rstField = dbs.OpenRecordset(strSQL, dbOpenDynaset)
        DoCmd.SetWarnings True
        If (rstField.EOF) Then
            Jdx = Jdx + 1
            Debug.Print Jdx, rst.Fields(Idx).Name
        End If
        Set rstField = Nothing
        Idx = Idx + 1
    Wend

End Function
Public Function basGetAllProperties()

    Dim olApp As Outlook.Application
    Dim objNameSpace As NameSpace
    Dim objContacts As MAPIFolder
    Dim objSubFolder As MAPIFolder
    Dim objContactItem As ContactItem
    Dim strFolderName As String
    Dim strFieldName As String
    Dim Quo As String * 1

    Dim Idx As Integer          'Subfolder (Just to wend our way their)
    Dim Jdx As Integer          'Individual Contact
    Dim Kdx As Integer          'Property (of / from the Contact)
    Dim Ldx As Integer          'Field of the New record to test for fill In


    Quo = Chr(34)

    Idx = 1         'Idx is the "Folder" pointer
    Set olApp = CreateObject("Outlook.Application")
    Set objNameSpace = olApp.GetNamespace("MAPI")
    Set objContacts = objNameSpace.GetDefaultFolder(olPublicFoldersAllPublicFolders)
    For Each objSubFolder In objContacts.Folders
        strFolderName = objSubFolder.Name
        If (strFolderName = "Common Contacts") Then
            Kdx = 1
            While Kdx <= objSubFolder.Items.Count
                Set objContactItem = objSubFolder.Items(Kdx)    'Kdx = Specific Contact
                    Jdx = 0                                     'Jdx = Property/Field index
                    Do While Jdx <= objContactItem.ItemProperties.Count - 1
                        strFieldName = objContactItem.ItemProperties(Jdx).Name
                        Debug.Print Space(4) & "olProperty" & "(" & Jdx & ") = " & Quo & strFieldName & Quo
                        Jdx = Jdx + 1
                    Loop
                    Exit Function
                Wend
            End If
        Next
End Function

The "key" (at least to me) is that Outlook appears to reveal the "Fields" as "Properties" of the contact item.

Review the procedure "basGetAllProperties". It generates a list of properties of the contact item formatted to copy and paste into another procedure as the assignemnt of the property name to an array variable. I have commented out the proerties which appear to NOT (IMHO) actually be fields of the data (as seen in the procedure "basMakeTablContacts" and "basDeclareFieldNames".

basMakrTableContacts is used to generate (a rather clumsy) table to hold the outlook information.

"basContactsToTable" is used to extract the outlook properties and generate records in the newly generated table. This uses a simplistic dodge to keep the list of property / field names in the seperate procedure "basDeclFieldNames".

The end result is to capture all of the property / field names from Outlook, select (comment out) the items which appear to NOT be of interest and collect all of the information into the table.

The remaining procedure ("basIdEmptyFields") was used just to identify fields which have no information for any of the records.

In "basContactsToTable", there are at least two items which are important to notice:

[tab]I was required to specifically obtain the information in the COMMON folder "Common Contacts", and thus the routine is set up to search PUBLIC folders for the specific contacts folder. Other users will probably need to modify these aspects for thier use.

More generally, these procedures require a reference to the Outlook library. Specifically, this uses Outlook 11.0 library.






MichaelRed