Sending Email with Multiple Attachments from Excel

Hi,

I got this very good Macro from some contributor on this site Called Callmailer which sends emals from Excel. However this particualr macro only supports an individual File attachement . I am trying to modify this code to include multiple attachements. I tried to use a comma but I guess that doesnt work. the file exam.xls is the list of the attachments I need to sent .

Also is there a modification of this code somewhere ??

Option Explicit

'Ensure that you select the Microsoft Outlook X.0 Object Library in the references

Sub CallMailer()
    
    Dim lngLoop As Long 'Programming ethics 1. Always start your first line after leaving a line space, and 1 indentation level
    
    With ActiveSheet
        For lngLoop = 2 To .Cells(Rows.Count, 1).End(xlUp).Row ' Programming ethics 3. Always indent your loops, case statements and with constructors
            Call SendMessage(strTo:=.Cells(lngLoop, 1).Value, strCC:=.Cells(lngLoop, 2).Value, strBCC:=.Cells(lngLoop, 7).Value, strMessage:=.Cells(lngLoop, 8).Value, strSubject:=.Cells(lngLoop, 3).Value, strAttachmentPath:=.Cells(lngLoop, 6).Value)
        Next lngLoop
    End With 'Programming ethics 2. Always end your last line leaving a line space before ending the sub or function, and having indendation level of 1
    
End Sub

 Sub SendMessage(strTo As String, Optional strCC As String, Optional strBCC As String, Optional strSubject As String, Optional strMessage As String, Optional strAttachmentPath As String, Optional blnShowEmailBodyWithoutSending As Boolean = False)

    Dim objOutlook As Outlook.Application
    Dim objOutlookMsg As Outlook.MailItem
    Dim objOutlookRecip As Outlook.Recipient
    Dim objOutlookAttach As Outlook.Attachment

    If Trim(strTo) & Trim(strCC) & Trim(strBCC) = "" Then
        MsgBox "Please provide a mailing address!", vbInformation + vbOKOnly, "Missing mail information"
        Exit Sub
    End If
    ' Create the Outlook session.
    On Error Resume Next
    Set objOutlook = GetObject(, "Outlook.Application")
    Err.Clear: On Error GoTo -1: On Error GoTo 0
    If objOutlook Is Nothing Then
        Set objOutlook = CreateObject("Outlook.Application")
    End If

    ' Create the message.
    Set objOutlookMsg = objOutlook.CreateItem(olMailItem)

    With objOutlookMsg
        ' Add the To recipient(s) to the message.
        If Trim(strTo) <> "" Then
            Set objOutlookRecip = .Recipients.Add(strTo)
            objOutlookRecip.Type = olTo
        End If
        
        ' Add the CC recipient(s) to the message.
        If Trim(strCC) <> "" Then
            Set objOutlookRecip = .Recipients.Add(strCC)
            objOutlookRecip.Type = olCC
        End If

       ' Add the BCC recipient(s) to the message.
       If Trim(strBCC) <> "" Then
            Set objOutlookRecip = .Recipients.Add(strBCC)
            objOutlookRecip.Type = olBCC
        End If

       ' Set the Subject, Body, and Importance of the message.
       If strSubject = "" Then
            strSubject = "This is a Test email"
       End If
       .Subject = strSubject
       If strMessage = "" Then
            strMessage = "Test ." & vbCrLf & vbCrLf
       End If
       .Body = strMessage & vbCrLf & vbCrLf
       .Importance = olImportanceHigh  'High importance

       ' Add attachments to the message.
       If Not IsMissing(strAttachmentPath) Then
            If Len(Dir(strAttachmentPath)) <> 0 Then
                Set objOutlookAttach = .Attachments.Add(strAttachmentPath)
            Else
                MsgBox "Unable to find the specified attachment. Sending mail anyway."
            End If
       End If

       ' Resolve each Recipient's name.
       For Each objOutlookRecip In .Recipients
           objOutlookRecip.Resolve
       Next

       ' Should we display the message before sending?
       If blnShowEmailBodyWithoutSending Then
           .Display
       Else
           .Save
           .Display
       End If
    End With
    
    Set objOutlook = Nothing
    Set objOutlookMsg = Nothing
    Set objOutlookAttach = Nothing
    Set objOutlookRecip = Nothing
    
End Sub