A
Anthony F.
Hello,
working on access 2002 to outlook 2002, I try to create
(from Access) a user-defined field (named "CodeContactInOutlook")
The creation seems to work.
But I can't fill this new user-defined field
as it remains empty for all my contacts.
(even though I fill it programmaticaly)
I work in the Contact default folder.
The code is :
------------------------------------------
Sub exportAccessContactsToOutlook()
' set up DAO Objects.
Dim db As DAO.Database
Dim rst As DAO.Recordset
Set rst = CurrentDb.OpenRecordset("Req Transfert Outlook")
' set up Outlook Objects.
Dim olookApp As New Outlook.Application
Dim olookSpace As Outlook.NameSpace
Dim olookFolder As Outlook.MAPIFolder
Dim olookContact As Outlook.ContactItem
Dim olookUserProp As Outlook.UserProperty
Dim colItems As Items
Set olookSpace = olookApp.GetNamespace("MAPI")
Set olookFolder = olookSpace.GetDefaultFolder(olFolderContacts)
Set colItems =
olookApp.GetNamespace("MAPI").GetDefaultFolder(olFolderContacts).Items
rst.MoveFirst
Do Until rst.EOF
With colItems.Add
Set olookContact =
olookApp.CreateItem(olContactItem)
olookContact.MessageClass = "IPM.Contact"
Set olookUserProp
=olookContact.UserProperties.Add("CodeContactInOutlook", olNumber)
olookUserProp = rst![Code Contact] 'name
in the Access table
.Save
End With
rst.MoveNext
Loop
rst.Close
End Sub
working on access 2002 to outlook 2002, I try to create
(from Access) a user-defined field (named "CodeContactInOutlook")
The creation seems to work.
But I can't fill this new user-defined field
as it remains empty for all my contacts.
(even though I fill it programmaticaly)
I work in the Contact default folder.
The code is :
------------------------------------------
Sub exportAccessContactsToOutlook()
' set up DAO Objects.
Dim db As DAO.Database
Dim rst As DAO.Recordset
Set rst = CurrentDb.OpenRecordset("Req Transfert Outlook")
' set up Outlook Objects.
Dim olookApp As New Outlook.Application
Dim olookSpace As Outlook.NameSpace
Dim olookFolder As Outlook.MAPIFolder
Dim olookContact As Outlook.ContactItem
Dim olookUserProp As Outlook.UserProperty
Dim colItems As Items
Set olookSpace = olookApp.GetNamespace("MAPI")
Set olookFolder = olookSpace.GetDefaultFolder(olFolderContacts)
Set colItems =
olookApp.GetNamespace("MAPI").GetDefaultFolder(olFolderContacts).Items
rst.MoveFirst
Do Until rst.EOF
With colItems.Add
Set olookContact =
olookApp.CreateItem(olContactItem)
olookContact.MessageClass = "IPM.Contact"
Set olookUserProp
=olookContact.UserProperties.Add("CodeContactInOutlook", olNumber)
olookUserProp = rst![Code Contact] 'name
in the Access table
.Save
End With
rst.MoveNext
Loop
rst.Close
End Sub