Frank
Frank

Reputation: 177

How to send an email with multiple attachments

This code is working well as long as every file is there. What is missing in the code for sending an email even if a file is missing? I have tried to find a solution but without success.

Set fso=CreateObject("Scripting.FileSystemObject")

strSMTP="smtp.telenor.no"
strSubject="Files form me to you"
strSubject="XXXXX"
strSubject="XXXX"
strBody="XXXXXX"
strAttach="File 1.csv"
strAttach1="File 2.csv"
strAttach2="File 3.csv"

If fso.FileExists(strAttach) then
Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")
iConf.Load -1    ' CDO Source Defaults
Set Flds = iConf.Fields
With Flds
    .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = strSMTP
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
    .Update
End With
With iMsg
    Set .Configuration = iConf
    .To = "XXXX"
    .CC = ""
    .BCC = ""
    .From = "XXXX"
    .Subject = strSubject
    .TextBody = strBody
    .AddAttachment strAttach
    .AddAttachment strAttach1
    .AddAttachment strAttach2
    .Send
End With
Set iMsg = Nothing
Set iConf = Nothing
Else
MsgBox "The specified attachment does not exist"
End if

Upvotes: 2

Views: 3624

Answers (1)

Étienne Laneville
Étienne Laneville

Reputation: 5021

The following uses an ArrayList to hold your attachments and adds them to the message one by one, checking if the file exists first:

Dim iCounter
Dim sAttachment
Dim objAttachments

Set objAttachments = CreateObject("System.Collections.ArrayList")

objAttachments.Add "File 1.csv"
objAttachments.Add "File 2.csv"
objAttachments.Add "File 3.csv"

Set objFSO = CreateObject("Scripting.FileSystemObject")

strSMTP = "smtp.telenor.no"
strSubject = "Files form me to you"
strSubject = "XXXXX"
strSubject = "XXXX"
strBody = "XXXXXX"

' Create message and configuration
Set objMessage = CreateObject("CDO.Message")
Set objConf = CreateObject("CDO.Configuration")

objConf.Load -1    ' CDO Source Defaults
Set objFields = objConf.Fields

With objFields
    .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = strSMTP
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
    .Update
End With

' Initalize message
With objMessage
    Set .Configuration = objConf
    .To = "XXXX"
    .CC = ""
    .BCC = ""
    .From = "XXXX"
    .Subject = strSubject
    .TextBody = strBody
End With

' Add attachments
For iCounter = 1 To objAttachments.Count
    sAttachment = objAttachments.Item(iCounter - 1)
    If objFSO.FileExists(sAttachment) Then objMessage.AddAttachment sAttachment
Next

' Send Message
objMessage.Send

Upvotes: 4

Related Questions