Linking Ms acces with an e-amil package

[ajc]

Wondering if its possible to link a table with e-mail addresses in it, with an e-mail package, sending out a standardised e-mail to certain people within the database table.

Many Thanks

ajc

[Kevin Wilcox]

Yes it is, you can send through outlokk. Here's some sample code, you'll need to modify it to suit.

Public Sub SendOutlookMessage( _
    strEmailAddress As String, _
    strEmailCCAddress As String, _
    strEmailBccAddress As String, _
    strSubject As String, _
    strMessage As String, _
    blnDisplayMessage As Boolean, _
    Optional strAttachmentFullPath As String)
 
'* Copy this code and paste it into a new Access
'* Module. Click Tools > References and make sure
'* that "Microsoft Office Outlook x.0 Object Library"
'* is checked.
'*
'* This subroutine sends an e-mail message through
'* MS Outlook. If the "blnDisplayMessage" parm is
'* set to "False", the message is placed in the
'* Outlook Outbox. "True" displays the message, and
'* user will have to click "Send" to send it.
'*
'* Ex.:
'*
'* SendOutlookMessage _
'*      "[e-mail]", _
'*      "[e-mail]", _
'*      "[e-mail]", _
'*      "Subject", _
'*      "Body of Message", _
'*      False, _
'*      "C:\My Documents\MyAttachmentFile.txt"
 
Dim objApp As Outlook.Application
Dim objOutlookMsg As Outlook.MailItem
Dim objOutlookRecipient As Outlook.Recipient
Dim objOutlookAttach As Outlook.Attachment
Dim blnOutlookInitiallyOpen As Boolean
Dim strProcName As String
 
On Error Resume Next
strProcName = "SendOutlookMessage"
 
blnOutlookInitiallyOpen = True
Set objApp = GetObject(, "Outlook.Application")
If objApp Is Nothing Then
    Set objApp = CreateObject("Outlook.Application")
    '* Outlook wasn't open when this function started.
    blnOutlookInitiallyOpen = False
End If
If Err <> 0 Then Beep: _
    MsgBox "Error in " & strProcName & " (1): " _
        & Err.Number & " - " & Err.Description: _
    Err.Clear: _
    GoTo Exit_Section
 
'Create the message
Set objOutlookMsg = objApp.CreateItem(olMailItem)
If Err <> 0 Then Beep: _
    MsgBox "Error in " & strProcName & " (2): " _
        & Err.Number & " - " & Err.Description: _
    Err.Clear: _
    GoTo Exit_Section
 
With objOutlookMsg
    Set objOutlookRecipient = .Recipients.Add(strEmailAddress)
    objOutlookRecipient.Type = olTo
    If strEmailCCAddress = "" Then
    Else
        Set objOutlookRecipient = .Recipients.Add(strEmailCCAddress)
        objOutlookRecipient.Type = olCC
    End If
    If strEmailBccAddress = "" Then
    Else
        Set objOutlookRecipient = .Recipients.Add(strEmailBccAddress)
        objOutlookRecipient.Type = olBCC
    End If
    .Subject = strSubject
    .Body = strMessage
 
    '* Add attachments
    If Not IsMissing(strAttachmentFullPath) Then
        If Trim(strAttachmentFullPath) = "" Then
        Else
            Set objOutlookAttach = .Attachments.Add(strAttachmentFullPath)
            If Err <> 0 Then Beep: _
                MsgBox "Error in " & strProcName & " (3): " _
                    & Err.Number & " - " & Err.Description: _
                Err.Clear: _
                GoTo Exit_Section
        End If
    End If
 
    If blnDisplayMessage Then
        .Display
    Else
        '* Send message by putting it in the Outbox
        .Send
    End If
End With
 
If Err <> 0 Then Beep: _
    MsgBox "Error in " & strProcName & " (99): " _
        & Err.Number & " - " & Err.Description: _
    Err.Clear: _
    GoTo Exit_Section
 
Exit_Section:
    On Error Resume Next
    If Not blnOutlookInitiallyOpen Then
       objApp.Quit
    End If
    Set objApp = Nothing
    Set objOutlookMsg = Nothing
    Set objOutlookAttach = Nothing
    Set objOutlookRecipient = Nothing
    On Error GoTo 0
End Sub