Sub EE_SendReport(rptRange As range, recipients As range, Files As range, Optional SendOrDisplay As Boolean, Optional ZipFileName As String)
'RptRange is a range containing text we want to be contained in the body
'Recipients is range containing email addresses Files is range containing
'list of files that we will zip up and add to mail SendOrDisplay - If= Send, mail is sent.. If Display, display mail.
    Const cstrAddSep            As String = ";"
    Dim arrTo
    Dim strTo           As String
    Dim arrAttach
    Dim strAttach       As String
    Dim strZipFile      As String
    Dim strFirstFile    As String
 
'http://excelexperts.com/xla-routines-eeSendReport    for updates on this sub routine

    arrTo = recipients
    If recipients.Cells.Count = 1 Then
        strTo = CStr(arrTo)
    Else
        strTo = Join(Application.Transpose(arrTo), cstrAddSep)
    End If
    arrAttach = Files
    If Files.Cells.Count = 1 Then
        strAttach = CStr(arrAttach)
        strFirstFile = strAttach
    Else
        strAttach = Join(Application.Transpose(arrAttach), ",")
        strFirstFile = Split(strAttach, ",")(0)
    End If
    strFirstFile = Left(strFirstFile, InStrRev(strFirstFile, ".") - 1)
 
    If ZipFileName <> "" Then
        strZipFile = Environ("Temp") & Application.PathSeparator & Replace(ZipFileName, ".zip", "") & ".zip"
    Else
        strZipFile = Environ("Temp") & Application.PathSeparator & EE_FileNameFromFilePath(strFirstFile) & ".zip"
    End If
 
    Call EE_ZipFile(Left(strZipFile, InStrRev(strZipFile, Application.PathSeparator)), EE_FileNameFromFilePath(strZipFile), strAttach)
 
    Call SendEmail(strTo, "", rptRange.value, Display, False, strZipFile)
 
    Kill strZipFile
End Sub
 
Public Function SendEmail(strMailTo As String, strSubject As String, _
    strBodyText As String, SendOrDisp As OptSendDisplay, blnReceipt As _
    Boolean, Optional strAttachment As String, Optional strCCTo As String, _
    Optional strBCCTo As String) As Long
'This will return 0 if successfull else error number

    Dim objApp                  As Object
    Dim objMail                 As Object
    Dim arrAttachment()         As String
    Dim intAttachLoop           As Integer
 
    DoEvents
 
    On Error GoTo ErrHandler
 
    Set objApp = CreateObject("Outlook.Application")
    Set objMail = objApp.CreateItem(0)
    With objMail
        .To = strMailTo
        If Len(strCCTo) > 0 Then .CC = strCCTo
        If Len(strBCCTo) > 0 Then .BCC = strBCCTo
        .Subject = strSubject
        .Body = strBodyText
        .ReadReceiptRequested = blnReceipt
 
        'Attachments
        If Len(strAttachment) > 0 Then
            arrAttachment() = Split(strAttachment, ",")
            For intAttachLoop = 0 To UBound(arrAttachment, 1)
                .Attachments.Add arrAttachment(intAttachLoop)
            Next intAttachLoop
        End If
        If SendOrDisp = Display Then .Display
        If SendOrDisp = Send Then .Send
    End With
 
    SendEmail = 0 'Success returned
    
exitSendAttachment:
    Set objApp = Nothing
    Set objMail = Nothing
    Exit Function
 
ErrHandler:
    SendEmail = Err.Number 'Error returned
    GoTo exitSendAttachment
 
End Function