INTELLIGENT WORK FORUMS
FOR COMPUTER PROFESSIONALS

Log In

Come Join Us!

Are you a
Computer / IT professional?
Join Tek-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!

*Tek-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Jobs

E-mail Attached Files

E-mail via Outlook with multiple recipients/attachments by mdthornton
Posted: 14 Mar 02

The following code will send an e-mail via Outlook to the specified (; separated) recipients, with the specified text as a subject. Body text, (; separated) attachments and a source folder for attachments are optional. You can embed a display name for the attachments by adding ***displayname to the filename (see example below). Without this the filename itself will be displayed. An example call would be:

SendEMail "test_subject", "mike@mikethornton.com;elliot@mikethornton.com", "test_body",ötest1.txt***Summary;test2.txt***detailö,öC:\temp\ö

Public Sub SendEMail(ByVal aSubject As String, ByVal aRecipients As String, Optional ByVal aBody As String = "", Optional ByVal aAttachments As String = "", Optional ByVal aRootPath As String = "")

    Dim myO As Outlook.Application
    Dim mobjNewMessage As Outlook.MailItem
    Dim sRecipient, sAttachment, sDisplayName As String
    Dim iMarker, iMarker2 As Integer
    
    On Error GoTo Error_SendEMail
    Set myO = CreateObject("Outlook.Application")
    Set mobjNewMessage = myO.CreateItem(olMailItem)
    mobjNewMessage.Subject = aSubject
    mobjNewMessage.Body = aBody
    ' Loop through ; separated recipients
    Do
        iMarker = InStr(1, aRecipients, ";", vbTextCompare)
        If iMarker = 0 Then
            sRecipient = aRecipients
        Else
            sRecipient = Mid(aRecipients, 1, iMarker - 1)
            aRecipients = Mid(aRecipients, iMarker + 1)
        End If
        If Len(sRecipient) <> 0 Then mobjNewMessage.Recipients.Add sRecipient
    Loop While iMarker <> 0
    
    ' Loop through ; separated attachments - also look for ***DisplayName
    Do
        iMarker = InStr(1, aAttachments, ";", vbTextCompare)
        If iMarker = 0 Then
            sAttachment = aAttachments
        Else
            sAttachment = Mid(aAttachments, 1, iMarker - 1)
            aAttachments = Mid(aAttachments, iMarker + 1)
        End If
        If Len(sAttachment) <> 0 Then
            ' Is there an embedded display name?
            iMarker2 = InStr(1, sAttachment, "***", vbTextCompare)
            If iMarker2 <> 0 Then
                sDisplayName = Mid(sAttachment, iMarker2 + 3)
                sAttachment = aRootPath + Mid(sAttachment, 1, iMarker2 - 1)
                If StrComp(Dir(sAttachment), "", vbTextCompare) <> 0 Then mobjNewMessage.Attachments.Add sAttachment, , , sDisplayName
            Else
                If StrComp(Dir(aRootPath + sAttachment), "", vbTextCompare) <> 0 Then mobjNewMessage.Attachments.Add aRootPath + sAttachment
            End If
        End If
    Loop While iMarker <> 0
    
    ' Send the message
    mobjNewMessage.Send
    
Exit_SendEMail:

    Set mobjNewMessage = Nothing
    Set myO = Nothing
    Exit Sub

Error_SendEMail:
    MsgBox Err.Description, , "Send Mail Error"
    Resume Exit_SendEMail
End Sub

Back to Microsoft: Access Modules (VBA Coding) FAQ Index
Back to Microsoft: Access Modules (VBA Coding) Forum

My Archive

Resources

Close Box

Join Tek-Tips® Today!

Join your peers on the Internet's largest technical computer professional community.
It's easy to join and it's free.

Here's Why Members Love Tek-Tips Forums:

Register now while it's still free!

Already a member? Close this window and log in.

Join Us             Close