Brilliant, thanks very much for your hel

Ron,
I have some code from your site that WAS working, but now is NOT attaching
the file to the email. I am creating the zip file, but also another file with
an "E" attached that I want to use as the attachment instead of the zip file.
The email is created and sent, but without the file attached. Could you
review the code and try to determine what the issue is? Thanks much!
PS..Flying to Amsterdam today..do you live close...I might like to take you
out for a drink! Here's my code:

Sub ZipMailWithDeleteOption()
Dim strDate As String, DefPath As String, strbody As String
   Dim oApp As Object, OutApp As Object, OutMail As Object
   Dim FileNameZip, FileNameXls, FileNameEmail
   Dim password As String
   
   'Checks to See If A Directory Exists, If Not, Creates It
   MyDirectory = ActiveWorkbook.Path & "\" & "Zipped Reports"
   DirTest = Dir$(MyDirectory, vbDirectory)
       If DirTest = "" Then
           MkDir MyDirectory
           DoEvents    'just to make sure it is there
       End If
   ChDir MyDirectory

   DefPath = MyDirectory
   
   If Right(DefPath, 1) <> "\" Then
       DefPath = DefPath & "\"
   End If

   strDate = Format(Now, " dd-mmm-yy h-mm-ss")
   'Create the temporary xls file and zip file name
   FileNameZip = DefPath & Left(ActiveWorkbook.Name,
Len(ActiveWorkbook.Name) - 4) & ".zip"
   FileNameXls = DefPath & Left(ActiveWorkbook.Name,
Len(ActiveWorkbook.Name) - 4) & "Z" & ".xls"
   FileNameEmail = Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 4)
& "E" & ".xls"
   
   If Dir(FileNameZip) = "" And Dir(FileNameXls) = "" Then

       'Make a copy of the activeworkbook
       ThisWorkbook.SaveCopyAs FileNameEmail
       'ThisWorkbook.Activate
       ThisWorkbook.SaveCopyAs FileNameXls

       'Create empty Zip File
       NewZip (FileNameZip)

       'Copy the xls file into the compressed folder
       Set oApp = CreateObject("Shell.Application")
       oApp.Namespace(FileNameZip).CopyHere FileNameXls

       'Keep script waiting until Compressing is done
       On Error Resume Next
       Do Until oApp.Namespace(FileNameZip).items.Count = 1
           Application.Wait (Now + TimeValue("0:00:01"))
       Loop
       On Error GoTo 0

       ChDir MyDirectory

'INSERT EMAIL CODE HERE!
       'Create the mail
       Set OutApp = CreateObject("Outlook.Application")
       Set OutMail = OutApp.CreateItem(0)
       strbody = "Attached is our Big Picture Report" & vbNewLine &
vbNewLine & _
                 strDate & vbNewLine & _
                 "" & vbNewLine & _
                 "Have a Nice Day!" & vbNewLine & _
                 ""

       On Error Resume Next
       With OutMail
           .To = "bigpicture@benfranklinplumbing.com"
           .CC = ""
           .BCC = ""
           .Subject = FileNameEmail
           '.Subject = FileNameXls
           .Body = strbody
           .Attachments.Add FileNameEmail
           .Send   'or use .Display
           '.Display
           Application.Wait (Now + TimeValue("0:00:02"))
           Application.SendKeys "%S"

       End With
       On Error GoTo 0

       Set OutMail = Nothing
       Set OutApp = Nothing
       Set oApp = Nothing

       'Delete the temporary xls file
       Kill FileNameXls
       Kill FileNameEmail
       
       ThisWorkbook.Activate
               
       MsgBox "Your Zipfile is Stored Here: " & FileNameZip

       Call CapturePlumberData
       
       Msg = "Do You Want to Delete This File and Keep Only the Zip File?"
       Ans = MsgBox(Msg, vbYesNo)
       If Ans = vbYes Then Call DeleteThisFile
       
   Else
       MsgBox "A ZipFile With This File Name Already Exist." & Chr(10) _
                                           & "Delete It and Try Again!"
   End If
   
   Application.ScreenUpdating = False
   
   Application.ThisWorkbook.Activate
   Worksheets("Global Setup").Select
       Range("CA3").Select
       password = Range("CA3").Value
       Range("L5").Select
       
   Worksheets("Team Scorecard").Activate
   
   Application.ThisWorkbook.Unprotect (password)
   ActiveSheet.Unprotect (password)
   
   Application.ScreenUpdating = True
   
   ActiveSheet.Shapes("Button 28").Select
   Selection.Characters.Text = "File Zipped" & Chr(10) & "& Mailed"
   With Selection.Characters(Start:=1, Length:=10).Font
       .Name = "Arial"
       .FontStyle = "Regular"
       .Size = 10
       .Strikethrough = False
       .Superscript = False
       .Subscript = False
       .OutlineFont = False
       .Shadow = False
       .Underline = xlUnderlineStyleNone
       .ColorIndex = 5
   End With
   Range("A1").Select
   
   ActiveSheet.Protect (password)
   Application.ThisWorkbook.Protect (password), structure:=True

End Sub

Thanks!