[AccessD] Access to Outlook

Susan,
I built a sample table...
	tblContacts
		ID
		Full Name
		Company
		File As
		E-mail
		Phone

...and added the following code:
	Function to add reference to Outlook2003
	Function to loop through tblContacts and add to Contacts in Outlook
	Sub to call the Functions

Seems to work OK for me.

HTH,
Kevin

Option Compare Database
Option Explicit

Function AddRefOutlook() As Boolean
    'Add a reference to Outlook 2003
    Dim strRef                               As String
    Dim ref                                  As Reference
    strRef = "C:\Program Files\Microsoft Office\Office11\msoutl.olb"
'My Office install in on my G drive
    'strRef = "G:\Program Files\Microsoft Office\Office11\msoutl.olb"

    On Error GoTo ErrorOnDLL

    Set ref = References.AddFromFile(strRef)

    Exit Function
ErrorOnDLL:
    'If the reference is already there then...
    If Err.Number = 32813 Then
        '...do something
Debug.Print "reference is already there"
AddRefOutlook = True
    Else
Debug.Print Err.Number & " " & Err.Description
AddRefOutlook = False
    End If

End Function

Function AddContacts()
    '---------
    'Must set reference to Outlook library
    '---------
    Dim rst                                  As New ADODB.Recordset
    Dim cnn                                  As New ADODB.Connection
    Dim ol                                   As New Outlook.Application
    Dim olns                                 As Outlook.NameSpace
    Dim fldContacts                          As Outlook.MAPIFolder
    Dim itms                                 As Outlook.Items
    Dim cf                                   As Object

    Set cnn = CurrentProject.Connection
    Set ol = CreateObject("Outlook.Application")
    Set olns = ol.GetNamespace("MAPI")
    ' Which folder is the contacts list in?
    Set fldContacts = olns.GetDefaultFolder(olFolderContacts)
    Set itms = fldContacts.Items

    rst.Open "tblContacts", cnn
    rst.MoveFirst
    Do While Not rst.EOF
        Set cf = itms.Add("IPM.Contact")
        With cf
            .FullName = rst.Fields(1).Value
            .CompanyName = rst.Fields(2).Value
            .FileAs = rst.Fields(3).Value
            .Email1Address = rst.Fields(4).Value
            If Not IsNull(rst.Fields(5).Value) Then
                .PrimaryTelephoneNumber = rst.Fields(5).Value
            End If
            .Save
        End With
        Set cf = Nothing
        rst.MoveNext
    Loop

    Set ol = Nothing
    Set olns = Nothing
    Set fldContacts = Nothing
    Set itms = Nothing

End Function

Sub Test()
    Dim x                                    As Variant
    x = AddRefOutlook
    x = AddContacts
End Sub
 


Famous Last Words:  'This should be easy...'

-----Original Message-----
From: accessd-bounces at databaseadvisors.com
[mailto:accessd-bounces at databaseadvisors.com] On Behalf Of Susan Harkins
Sent: Monday, November 12, 2007 2:16 PM
To: AccessD at databaseadvisors.com
Subject: [AccessD] Access to Outlook

I posted the following code on the tech list this weekend, but so far
haven't resolved the problem I'm having. I'm trying to send Access values to
Outlook as a new contact. The   Set itm = itms.Add("IPM.Contact") statement
returns a can't set object variable error. 

Susan H. 




Function SendContactsToOutlook()

  Dim rst As New ADODB.Recordset
  Dim cnn As New ADODB.Connection
  '---------
  'Must set reference to Outlook library
  '---------
  Dim itms As Outlook.Items
  Dim itm As Outlook.ContactItem
  Set cnn = CurrentProject.Connection
  rst.Open "tblContacts", cnn

  'Outlook Folder name is hardcoded
  
  Set itm = itms.Add("IPM.Contact")
  
  With itm
    .CustomerID = Nz(rst!CustomerID)
    .FirstName = Nz(rst!FirstName)
    .LastName = Nz(rst!LastName)
    .Department = Nz(rst!Department)
    .Birthday = Nz(rst!Department)
    .Close (olSave)
    'DoCmd.RunCommand acCmdSaveRecord
  End With
  

   
  
  Set rst = Nothing
  Set cnn = Nothing
  Set itms = Nothing
  Set itm = Nothing
  
End Function
--
AccessD mailing list
AccessD at databaseadvisors.com
http://databaseadvisors.com/mailman/listinfo/accessd
Website: http://www.databaseadvisors.com