Email with multiple attachments

Hi,

I have been using some CDO email code for a while now, but I have only ever needed to attach 1 file.

For my current project I need to send upto 3 attachments.

The first depends on if there is a file path in name range "PDESC" and the other 2 files are the activeworkbook, which is saved in a folder called STAFF CHANGES BACKUP on the desktop, along with a word doc with the same file name as the active workbook found in the same folder.

So there should always be 2 attachments but occasionally there should be 3. Another problem I noticed when just testing the attachment who's file path is in range PDESC is that if the field is blank it creates a blank attachment which I don't really want.


Any ideas?

Here is my email code:

Public xBook As Workbook
Public iSh As Worksheet




Sub EMAILLIST()

    Dim cell As Object
    Dim NR As Long
    Dim tagerror As String
    Dim Email_Send_To, Email_Send_From, Email_Subject, Email_Body As String
    Dim strUserEmail As String
    Dim strFirstClassPassword As String
    Dim errPar As String
    Dim iMsg As Object
    Dim iConfig As Object
    Dim sConfig As Variant
    Dim Row As Integer
    Dim Atc As String
    
    
    Set xBook = activeworkbook
    Set iSh = xBook.Sheets("INPUT")
    
        
    strUserEmail = xBook.Sheets("INPUT").Range("MMAIL")
    strFirstClassPassword = ""

    Set iMsg = CreateObject("CDO.Message")
    Set iConfig = CreateObject("CDO.Configuration")
    iConfig.Load -1
    Set sConfig = iConfig.Fields
        
        With sConfig
            .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
            .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "192.168.0.5" 'Name or IP of remote SMTP server
            .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25  'Server Port
            .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = strUserEmail
            .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = strFirstClassPassword
            .Update
        End With
     
With Application
    .ScreenUpdating = False
    .EnableEvents = False
End With
   

 '-----------------------------------------------------------------------------

    Email_Send_To = iSh.Range("AMAIL")
    Email_Send_From = iSh.Range("MMAIL")
    Email_Subject = "CHANGE REQUEST"
    Email_Body = "Dear " & iSh.Range("ANAME") & "," & vbNewLine & vbNewLine _
                & "Please complete this change request which was submitted by " & iSh.Range("MNAME") _
                & " on the " & Format(Now, "dd/mm/yyyy") & ". To complete this request please download the " _
                & "attached files to your desktop. If you only have a word document, please print this off, " _
                & "sign it and return it to HR. If there is also an excel sheet, once you have downloaded it " _
                & "open it and check the details. If you give permission for this change request, click the " _
                & "'Authorise' button. If you get a message saying unable to connect, then you must print off " _
                & "the word document and submit it to HR." & vbNewLine & vbNewLine _
                & "Any queries should be directed to your segment's HR team who will be happy to help." _
                & vbNewLine & vbNewLine _
                & "Kind regards," & vbNewLine & vbNewLine _
                & "HR"
                
    

'-----------------------------------------------------------------------------
         

    With iMsg
        Set .Configuration = iConfig
    End With
    
            iMsg.To = Email_Send_To
            iMsg.From = Email_Send_From
            iMsg.Subject = Email_Subject
            iMsg.Textbody = Email_Body
            iMsg.AddAttachment iSh.Range("PDESC")
            iMsg.Send
    
    Exit Sub

On Error GoTo tagerror


'clean_up:
'    With Application
'       .EnableEvents = True
'       .ScreenUpdating = True
'    End With
 

    
tagerror:
    MsgBox "Error: (" & Err.Number & ") " & Err.Description & " at " & Err.Source, vbCritical
    'Resume clean_up

    
End Sub