How to send Email with Attachment(s) from within MS Access?

[tasawer]

Hi,
I would like to send emails with attachments from within MSACESS 2003.

I have used Microsofts example that allows to send an email with an attahcment to many recipients.
http://support.microsoft.com/?id=318881#appliesto

What I would like to do is to send Many Attachments to many Recipients. I am failing miserably from the word go.

My main table that stores email address is tbl_Accident_CaseHandler
I filter the emails to select the required email address with qryCaseHandler

SELECT tbl_Accident_CaseHandler.CaseHandlerID, tbl_Accident_CaseHandler.AccidentID, tbl_Accident_CaseHandler.ContactID, tbl_Accident_CaseHandler.SupplierID, tbl_Accident_CaseHandler.CaseHandlerName, tbl_Accident_CaseHandler.CaseHandlerPhone, tbl_Accident_CaseHandler.CaseHandlerEmail AS EmailAddress, tbl_Accident_CaseHandler.CaseHandlerNotes
FROM tbl_Accident_CaseHandler
WHERE (((tbl_Accident_CaseHandler.AccidentID)=[Forms]![AccidentClaims]![AccidentID]) AND ((tbl_Accident_CaseHandler.ContactID)=[Forms]![AccidentClaims]![txtContactID]));
 

I modified microsofts Module to include my queries and form but even in the most basic form, i get the error '3061 Too Few Parameters. Expected 2.

I have not got near modifying the attachments section. :)

My attachment paths are stored in qryMailingAttachment as DocPath

SELECT tbl_AccDocuments.DocumentID, tbl_AccDocuments.AccidentID, tbl_AccDocuments.ContactID, tbl_AccDocuments.DocPath, tbl_AccDocuments.DocDescription, tbl_AccDocuments.SendAsAttachment
FROM tbl_AccDocuments
WHERE (((tbl_AccDocuments.AccidentID)=[Forms]![AccidentClaims]![AccidentID]) AND ((tbl_AccDocuments.ContactID)=[Forms]![AccidentClaims]![txtContactID]) AND ((tbl_AccDocuments.SendAsAttachment)=True));
 

These queries are producing the required results.
I am not sure where to go from here.
Thanks in advance for excellent support that is always provided on BYTES.

p.s. Is there a method to collect emails within MSACESS

Micrsofts Module (Modified)

Sub SendMessages(Optional AttachmentPath)
 
'Information Taken from the followinh microsoft website
'http://support.microsoft.com/?id=318881#appliesto
'Add Microsoft Outlook Object 11.0 Library
 
'Addition for Attachments
'http://en.allexperts.com/q/Using-MS-Access-1440/2010/2/Sending-Multiple-Attachments-via.htm
 
  Dim MyDB As Database
  Dim MyRS As Recordset
  Dim objOutlook As Outlook.Application
  Dim objOutlookMsg As Outlook.MailItem
  Dim objOutlookRecip As Outlook.Recipient
  Dim objOutlookAttach As Outlook.Attachment
  Dim TheAddress As String
 
  Set MyDB = CurrentDb
  Set MyRS = MyDB.OpenRecordset("qryMailingList")
  MyRS.MoveFirst
 
  ' Create the Outlook session.
  Set objOutlook = CreateObject("Outlook.Application")
 
  Do Until MyRS.EOF
  ' Create the e-mail message.
  Set objOutlookMsg = objOutlook.CreateItem(olMailItem)
  TheAddress = MyRS![EmailAddress]
 
     With objOutlookMsg
        ' Add the To recipients to the e-mail message.
        Set objOutlookRecip = .Recipients.Add(TheAddress)
        objOutlookRecip.Type = olTo
 
        ' Add the Cc recipients to the e-mail message.
        If (IsNull(Forms!SendEmail!ccAddress)) Then
        Else
           Set objOutlookRecip = .Recipients.Add(Forms!SendEmail!ccAddress)
           objOutlookRecip.Type = olCC
        End If
 
        ' Set the Subject, the Body, and the Importance of the e-mail message.
        .Subject = Forms!SendEmail!Subject
        .Body = Forms!SendEmail!MainText
        .Importance = olImportanceHigh  'High importance
 
        'Add the attachment to the e-mail message.
        If Not IsMissing(AttachmentPath) Then
           Set objOutlookAttach = .Attachments.Add(AttachmentPath)
        End If
 
        ' Resolve the name of each Recipient.
        For Each objOutlookRecip In .Recipients
           objOutlookRecip.Resolve
           If Not objOutlookRecip.Resolve Then
             objOutlookMsg.Display
           End If
        Next
        .Send
      End With
      MyRS.MoveNext
   Loop
   Set objOutlookMsg = Nothing
   Set objOutlook = Nothing
End Sub

[ADezii]

Just subscribing for now...

[ADezii]

I created some Code for you which hopefully will be helpful (say that fast 10 times!). It Sends Multiple Attachments to Multiple Recipients via Outlook, based on your specifications. Any questions, feel free to ask.

'Provides the Send Mail automation. Send an E-Mail and
'Attachments from Access via Outlook to Multiple Recipients
Dim oLook As Object
Dim oMail As Object
Dim olns As Outlook.NameSpace
Dim MyDB As DAO.Database
Dim rstAddr As DAO.Recordset        'To hold E-Mail Addresses of Recipients
Dim rstAtt As DAO.Recordset         'To hold Path of all Attachments
Dim strBuild As String
 
Set oLook = CreateObject("Outlook.Application")
Set olns = oLook.GetNamespace("MAPI")
Set oMail = oLook.CreateItem(0)
 
Set MyDB = CurrentDb
Set rstAddr = MyDB.OpenRecordset("qryCaseHandler", dbOpenForwardOnly)
Set rstAtt = MyDB.OpenRecordset("qryMailingAttachments", dbOpenForwardOnly)
 
With oMail
  With rstAddr
    Do While Not .EOF
      strBuild = strBuild & ![EMailAddress] & ";"       'Build Recipients List
        .MoveNext
    Loop
  End With
    .To = Left$(strBuild, Len(strBuild) - 1)            'Strip Trailing ';'
 
    .Body = "Text in the Body of the E-Mail"
 
    .Subject = "Some Interesting Subject"
 
  With rstAtt
    Do While Not .EOF
      oMail.Attachments.Add Trim(![DocPath])
        .MoveNext
    Loop
  End With
 
    .Display          'Displays the Outlook Screen instead of automatically Sending
                      'the Email. You can change this to .Send to Auto Send
End With
 
Set oMail = Nothing
Set oLook = Nothing
 
rstAtt.Close
rstAddr.Close
Set rstAtt = Nothing
Set rstAddr = Nothing

[tasawer]

Hi Adezzi,

I closed my eyes and said it 10 times... but guess what it did not work. Sorry.
its probably not your code because the error remains the same.. 3061 too few parameters. Expected 2.

I have experienced this error in my sql commands when the command is expecting a value (Expected 1) or 2 (Expected 2) but does not get it.

Perhaps, the error is in my queries!
Nevertheless, when I put the following code behind click property of command button, desired values are shown.

Me.MainText = Me.MessageBody & vbCrLf & vbCrLf & Me.Footer
 
    DoCmd.OpenQuery "qryCaseHandler", acViewNormal
    DoCmd.OpenQuery "qryMailingAttachment", acViewNormal
    Debug.Print Me.MainText
    Debug.Print Me.Subject

[ADezii]

Try a different approach and see what happens.

1. Resolve the Parameters initially.
2. Change the SQL of the Query.
3. Now, you should be able to create a Recordset based on the Query.
   

   Dim strSQL As String
   Dim qdf As DAO.QueryDef
    
   strSQL = "SELECT tbl_Accident_CaseHandler.CaseHandlerID, tbl_Accident_CaseHandler.AccidentID, " & _
            "tbl_Accident_CaseHandler.ContactID, tbl_Accident_CaseHandler.SupplierID, " & _
            "tbl_Accident_CaseHandler.CaseHandlerName, tbl_Accident_CaseHandler.CaseHandlerPhone, " & _
            "tbl_Accident_CaseHandler.CaseHandlerEmail AS EmailAddress, tbl_Accident_CaseHandler.CaseHandlerNotes " & _
            "FROM tbl_Accident_CaseHandler " & _
            "WHERE tbl_Accident_CaseHandler.AccidentID = " & [Forms]![AccidentClaims]![AccidentID] & " AND " & _
            "tbl_Accident_CaseHandler.ContactID= " & [Forms]![AccidentClaims]![txtContactID] & ";"
    
   Set qdf = CurrentDb.QueryDefs("qryCaseHandler")
    
   qdf.SQL = strSQL

4. P.S. - I assumed that the ID Fields are Numeric.

[tasawer]

Hi Adezzi,

Here is an update,

As I suspected, I added the following lines to your code

  Dim lngAccidentID As Long
  Dim lngContactID As Long
  Dim strSQlEmail As String
  Dim strSqlAttachments As String
 
  lngAccidentID = Forms!AccidentClaims!AccidentId
  lngContactID = Forms!AccidentClaims!txtContactID
 
  strSQlEmail = "SELECT tbl_Accident_CaseHandler.CaseHandlerEmail " & _
        "FROM tbl_Accident_CaseHandler " & _
        "WHERE (AccidentID= " & lngAccidentID & " AND ContactID= " & lngContactID & " );"
 
  strSqlAttachments = "SELECT tbl_AccDocuments.DocPath " & _
        "FROM tbl_AccDocuments " & _
        "WHERE (AccidentID= " & lngAccidentID & " AND ContactID= " & lngContactID & " AND SendAsAttachment=-1);"
 

and I edited these lines..

    Set MyDB = CurrentDb
    Set rstAddr = MyDB.OpenRecordset(strSQlEmail, dbOpenForwardOnly)
    Set rstAtt = MyDB.OpenRecordset(strSqlAttachments, dbOpenForwardOnly)

and now it works a treat. I am not sure why it will not read the queries. do you?

[tasawer]

Great men think alike....

[ADezii]

You need to properly Evaluate the Query Parameters, prior to Opening a Recordset based on the Query, as such:

'Form must be Open in order for Parameters to be properly evaluated
Dim qdf As DAO.QueryDef
Dim prm As Parameter
Dim rst As DAO.Recordset
 
Set qdf = CurrentDb.QueryDefs("qryCaseHandler")
 
For Each prm In qdf.Parameters
  prm.Value = Eval(prm.Name)
Next
 
Set rst = qdf.OpenRecordset
 
rst.MoveLast
 
MsgBox rst.RecordCount