Zip and mail more than one sheet from the ActiveWorkbook

[Martin]

Hi everybody,
I have used Ron's (de Bruin) web page quite a lot and found it very, very
useful. Normally I am able to amend his code into exactly what I need. But
this time I am struggling. In VBA I am trying to "Zip and mail more than one
sheet from the ActiveWorkbook".

Any help much appreciated.

 

[Ron de Bruin]

Hi Martin

Create a workbook with only the sheets you want with code
and save/zip that workbook

Do you use the Winzip code or the code from the default Windows zip page
Let me know and I will post a example

 

[Martin]

Hi Ron,

Yes please post an example. I tried to combine two VBA examples on your web
site but was not successful.

I am using WinZip.

Thanks a lot for your help.

--
Regards,

Martin

Hi Martin

Create a workbook with only the sheets you want with code
and save/zip that workbook

Do you use the Winzip code or the code from the default Windows zip page
Let me know and I will post a example

 

[Ron de Bruin]

Untested but this will send two sheets in a new workbook

For others the code that Martin used is on this page
http://www.rondebruin.nl/zip.htm

Change this line in the code to your sheets

ActiveWorkbook.Sheets(Array("Sheet1", "Sheet3")).Copy


Sub Test_Zip_Mail()
'This sub will send a newly created workbook with the sheets in the array.
'It save and zip the workbook before mailing it with a date/time stamp.
'After the zip file is sent the zip file and the workbook will be deleted from your hard disk.
Dim PathWinZip As String, FileNameZip As String, FileNameXls As String
Dim ShellStr As String, strDate As String
Dim OutApp As Object
Dim OutMail As Object
Dim Destwb As Workbook

PathWinZip = "C:\program files\winzip\"
'This will check if this is the path where WinZip is installed.
If Dir(PathWinZip & "winzip32.exe") = "" Then
MsgBox "Please find your copy of winzip32.exe and try again"
Exit Sub
End If

' Build the date/Time string
strDate = Format(Now, "dd-mm-yy h-mm-ss")

' Build the path and name for the zip file
FileNameZip = ActiveWorkbook.Path & "\" & Left(ActiveWorkbook.Name, _
Len(ActiveWorkbook.Name) - 4) & " " & strDate & ".zip"

' Build the path and name for the xls file
FileNameXls = ActiveWorkbook.Path & "\" & Left(ActiveWorkbook.Name, _
Len(ActiveWorkbook.Name) - 4) & " " & strDate & ".xls"

'Copy the sheets to a new workbook
ActiveWorkbook.Sheets(Array("Sheet1", "Sheet3")).Copy
Set Destwb = ActiveWorkbook
Destwb.SaveAs Filename:=FileNameXls
Destwb.Close False

'Zip the file
ShellStr = PathWinZip & "Winzip32 -min -a" _
& " " & Chr(34) & FileNameZip & Chr(34) _
& " " & Chr(34) & FileNameXls & Chr(34)
ShellAndWait ShellStr, vbHide

'Send the File
Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
Set OutMail = OutApp.CreateItem(0)
With OutMail
.To = "(e-mail address removed)"
.CC = ""
.BCC = ""
.Subject = "ZipMailTest"
.Body = "Here is the File"
.Attachments.Add FileNameZip
.send
End With
Set OutMail = Nothing
Set OutApp = Nothing

'Delete the file that you saved with SaveCopyAs and the Zip file
Kill FileNameZip
Kill FileNameXls
End Sub



--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm

Hi Ron,

Yes please post an example. I tried to combine two VBA examples on your web
site but was not successful.

I am using WinZip.

Thanks a lot for your help.

 

[Martin]

Thank you very much!

It is working like a dream.