Results 1 to 3 of 3
  1. #1
    2 Star Lounger
    Join Date
    Jan 2005
    Wichita, Kansas, USA
    Thanked 0 Times in 0 Posts

    Multiple attachments in email form (2007)

    Below is the code used in a function for a form for sending email with an attachment. Can anyone tell me if there is a way to be able to attach multiple attachments? (I am using a "Browse" button to select the file for attachment.)

    Option Compare Database
    Option Explicit

    Function SendMessages(QueryName As String, _
    FieldName As String, _
    ReplyTo As String, _
    Optional AttachmentPath As String = "None")
    Dim MyDB As DAO.Database
    Dim MyRS As DAO.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
    Dim strReplyaddress As String
    Set MyDB = CurrentDb
    Set MyRS = MyDB.OpenRecordset(QueryName)

    ' Create the Outlook session.
    Set objOutlook = CreateObject("Outlook.Application.12")

    Do Until MyRS.EOF
    ' Create the e-mail message.
    Set objOutlookMsg = objOutlook.CreateItem(olMailItem)
    TheAddress = MyRS.Fields(FieldName)
    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!frmMail!CCAddress)) Then
    Set objOutlookRecip = .Recipients.Add(Forms!frmMail!CCAddress)
    objOutlookRecip.Type = olCC
    End If

    ' Set the Subject, the Body, and the Importance of the e-mail message.
    .Subject = Forms!frmMail!Subject
    .Body = Forms!frmMail!MainText
    .Importance = olImportanceHigh 'High importance

    If Not ReplyTo = "" Then
    .ReplyRecipients.Add ReplyTo
    End If
    'Add the attachment to the e-mail message.
    If AttachmentPath <> "None" 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
    End With
    MsgBox "Your email message has been sent"
    Set objOutlookMsg = Nothing
    Set objOutlook = Nothing
    End Function

  2. #2
    Super Moderator
    Join Date
    Jun 2002
    Mt Macedon, Victoria, Australia
    Thanked 45 Times in 44 Posts

    Re: Multiple attachments in email form (2007)

    Have you tried just adding a second text box and a second Browse button to the form, then adding a second attachment parameter to the function?
    Then if that works add a third!

  3. #3
    Plutonium Lounger
    Join Date
    Mar 2002
    Thanked 28 Times in 28 Posts

    Re: Multiple attachments in email form (2007)

    If you want to be more flexible, you could change the AttachmentPath argument to a ParamArray:

    Function SendMessages(QueryName As String, _
    FieldName As String, _
    ReplyTo As String, _
    ParamArray AttachmentPath())

    Parse the array like this:

    Dim i As Integer
    For i = LBound(AttachmentPath) To UBound(AttachmentPath)
    Next i

    Call the function like this:

    Call SendMessages("qryTest", "Email", "", "CocsDoc1.doc", "CocsDoc2.doc")

    You can specify any number of attachments at the end, separated by commas.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts