Re: Email Attachment Problem

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" wrote:

> 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
>
>
> --
> Regards Ron de Bruin
> http://www.rondebruin.nl
>
>
> "David" <David@xxxxxxxxxxxxxxxxxxxxxxxxx> wrote in message news:DEBFBE6D-ADE3-41DB-86D9-0E566D3BBF50@xxxxxxxxxxxxxxxx
> >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@xxxxxxxxxxxxxxxxxxxxxxx"
> > .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)
> > Active***.Unprotect (password)
> >
> > Application.ScreenUpdating = True
> >
> > Active***.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
> >
> > Active***.Protect (password)
> > Application.ThisWorkbook.Protect (password), structure:=True
> >
> > End Sub
> >
> > Thanks!
> >
>
>
>
.