Email Attachment Problem

[David]

I have some code from Ron's site that WAS working, but now is NOT attaching
a file to the email when I added some code. 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 someone
review the code and try to determine what the issue is? Thanks much!
Hey Ron...if you get this..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 = "(e-mail address removed)"
.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!

 

[Ron de Bruin]

Hi David

Add Option Explicit on top of your module and add a few dim lines in the sub

Add DefPath here also

FileNameEmail = DefPath & Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 4) & "E" & ".xls"

Why do you use Chdir ???

For others this is the website David used
http://www.rondebruin.nl/windowsxpzip.htm

Hey Ron...if you get this..flying to Amsterdam today..do you live close...I
might like to take you out for a drink!

One hour for me with the car

 

[David]

That got it!
I'm staying at the Victoria Hotel, directly across from Central Station. If
you would like to take the train or drive up, I'd be more than happy to buy
you a beer or two and have the chance to meet you and thanks for all the
help. Let me know!

David Perkins

 

[David]

I use the ChDir so I can work on the extra files in the zipped files
directory. I created another filename string, so I can use it in the subject
line...WITHOUT the full path name...just the file name, but using the full
path for the attachment. As I'm doing it this way, maybe I don't need the
ChDir and set the default to the zipped files directory. Anyway...it works!

 

[Ron de Bruin]

Hi David

I have no time this weekend because my wife is on holiday with
here girlfriends this weekend and I am alone with the kids.

Have fun in Amsterdam