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 = "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!
Ron de Bruin - 20 Jan 2006 21:59 GMT
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

Signature
Regards Ron de Bruin
http://www.rondebruin.nl
>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
[quoted text clipped - 147 lines]
>
> Thanks!
David - 20 Jan 2006 22:46 GMT
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
> Hi David
>
[quoted text clipped - 165 lines]
> >
> > Thanks!
Ron de Bruin - 21 Jan 2006 10:25 GMT
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

Signature
Regards Ron de Bruin
http://www.rondebruin.nl
> That got it!
> I'm staying at the Victoria Hotel, directly across from Central Station. If
[quoted text clipped - 173 lines]
>> >
>> > Thanks!
David - 20 Jan 2006 22:50 GMT
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!
> Hi David
>
[quoted text clipped - 165 lines]
> >
> > Thanks!