how to connect access with outlook's contact folder

[newbiess]

hi there...
I'm having trouble with finding the answer to this.

I have a combo box that has all the names of the people that are in my microsoft access contact list table. Now i would like to some how when i click submit or done/whatever that will end the data input, an email is sent out to that person that is being selected by checking my outlook's contact folder for his/her email address. It would be really nice if this is automated, meaning that the email composer didn't appear but instead it would send a pre made message. Please help me out, this means a lot.

thanx to all

 

[redapples]

newbiess, this is pretty technical stuff but I can give you some code that might help you on your way.
the following requires the reference to Microsoft outlook in VBA

    Dim objOutlook As Object
    Dim objItem As Object
    Dim strMailTo  As String
    Dim strName
    Dim strtype
    Dim iIndid
       

    'Create a Microsoft Outlook object.
    Set objOutlook = CreateObject("Outlook.Application")

    'Create and open a new contact form for input.
    Set objItem = objOutlook.CreateItem(olMailItem)
    
    strMailTo = DIRECTEMAIL.Text
    If strMailTo <> &quot;&quot; Then 'Not IsNull(strMailTo) Or
    
    objItem.To = strMailTo
    'cant remeber the exact code for message text
    'will be somthing like,
    'objItem.MessageText = &quot;insert message&quot;

    'objItem.Display 
    objitem.send ' or something similar
    End If

    'Quit Microsoft Outlook.
    Set objOutlook = Nothing

the following code allows me to look into my a shared contacts folder and do stuff with it something in there is sure to help. Basicly one function uses Jet4.0 to add entries and the other uses DAO to read it.

Function addmailaddy(strFirstName, strSecondName, strEmailAddy)
    Dim ol As Outlook.Application
    Dim olns As Outlook.NameSpace
    Dim objAllFolders As MAPIFolder
    Dim objPublicFolders As MAPIFolder
    Dim objFolder As MAPIFolder
    Dim objAllContacts As Outlook.Items
    Dim Contact As Outlook.ContactItem
    Dim check As Boolean
    Dim lngindex As Long
    Dim strEmail As String
    Dim i As Integer

    Set ol = Outlook.Application
    Set olns = ol.GetNamespace("MAPI")
    Set objAllFolders = olns.Folders("Public Folders")
    Set objPublicFolders = objAllFolders.Folders("All Public Folders")
    Set objFolder = objPublicFolders.Folders("GHN Contacts")
    Set objAllContacts = objFolder.Items
    On Error GoTo ErrHandler
    
    strEmail = strEmailAddy
    
    
    If Not IsNull(strEmailAddy) Then '1
        Call checkalreadythere(check, lngindex, strEmailAddy, strFirstName, strSecondName)
        If check Then '2
            Exit Function
        Else '2
            If lngindex = 1 Then '3
                lngindex = MsgBox("An entry exists for this person with the E-mail:" _
                        & Chr(13) & strEmailAddy & Chr(13) & "Change the address in the Address book?", vbYesNo)
                If lngindex = 6 Then '4
                    i = 1
                    Do While lngindex = 6
                    Set Contact = objAllContacts.Item(i)
                        If Contact.FIRSTNAME = strFirstName And Contact.LastName = strSecondName Then
                            '5
                            lngindex = 0
                            Contact.Email1Address = strEmail
                            Contact.Save
                        End If '5
                    i = i + 1
                    Loop
                Else '4
                    Exit Function
                End If '4
            Else '3
                Set Contact = objAllContacts.Add(olContactItem)
                Contact.FIRSTNAME = strFirstName
                Contact.LastName = strSecondName
                Contact.Email1Address = strEmailAddy
                Contact.Display (True)
            End If '3
        End If '2
    Else
        Exit Function
    End If '1
   
    Set ol = Nothing
    Set olns = Nothing
    Set objAllFolders = Nothing
    Set objPublicFolders = Nothing
    Set objFolder = Nothing
    Set objAllContacts = Nothing
    Set Contact = Nothing
ExitHere:
Exit Function
ErrHandler:
    Select Case Err.Description
    Case "Array index out of bounds."
     'should not be able to get here but just in case
        Exit Function
    End Select
    
    Select Case Err.Number
    Case 13
    i = i + 1
    Resume
    Case Else
        MsgBox "Err: " & Err.Number & Err.Description & Err.HelpFile, vbCritical
    End Select
End Function


Function checkalreadythere(ByRef isthere, ByRef lngfound, ByRef strEmail, ByRef strFirstName, ByRef strSecondName)
    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    Dim fld As DAO.Field
    Dim i
    Dim strConnect As String

    strConnect = "Exchange 4.0;MAPILEVEL=\Outlook Address Book\;TABLETYPE=1;user = sconnell"
   
    Set db = OpenDatabase("c:\temp\", False, False, strConnect)
    Set rs = db.OpenRecordset("GHN Contacts")
    rs.MoveFirst
    i = 1
    
    'rs.FindFirst ("First = " & txtfirstname)
    Do Until i = -1 Or i = rs.RecordCount
    If rs!First = strFirstName Then '3
        If rs!Last = strSecondName Then '2
            If rs![E-mail address] = strEmail Then '1
                isthere = True
                i = -2 'next loop will be -1 thus ending loop
            Else
                strEmail = rs![E-mail address]
                lngfound = 1
                isthere = False
                i = -2 'next loop will be -1 thus ending loop
            End If '1
         End If '2
    End If '3
    i = i + 1
    rs.MoveNext
    Loop
    Set db = Nothing
    Set rs = Nothing
End Function

sorry to carpet bomb you with information but I am on my way out of the office. Let me know how you get on and I will check back tomorrow of next week (as time allows) to explain this or give a bit more advice.

redapples