Home | Contact Us | FAQ | Search & Site Map | Link to Us
Sign In | Join | Other 45 Sites in Network
Home
DiscussionsAccessExcelInfoPathOutlookPowerPointPublisherWord
DirectoryUser Groups
Related Topics
Outlook ExpressInternet ExplorerWindowsMS Server ProductsMore Topics ...

MS Office Forum / Excel / Programming / January 2006

Tip: Looking for answers? Try searching our database.

Email Attachment Problem

Thread view: 
Enable EMail Alerts  Start New Thread
Thread rating: 
David - 20 Jan 2006 20:21 GMT
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!
 
Sign In
Join
My Latest Posts
My Monitored Threads
My Blog
My Photo Gallery
My Profile
My Homepage

Start New Thread
Enable EMail Alerts
Rate this Thread



©2008 Advenet LLC   Privacy Policy - Terms of Use
This website includes both content owned or controlled by Advenet as well as content owned or controlled by third parties.