Add files to ZIP using VBA

[Steve]

Hi hope someone can help me out
The code below will ZIP the active workbook and send the zip file via email

1. I need to insert addition files into the ZIP archive before it hits the
email
2. I need Outlook to setup the email but NOT send the file (ie I'd like to
manually press send...)

Any ideas much appeciated



Sub ActiveWorkbook_Zip_Mail()
'This sub will send a newly created workbook (copy of the Activeworkbook).
'It zip and save 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 Runwzzip As Long
Dim OutApp As Outlook.Application
Dim OutMail As Outlook.MailItem

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

esaName = ActiveSheet.Range("f6").Value
seqNumber = ActiveSheet.Range("b6").Value
FileNameZip = "C:\rds\zipped\" & seqNumber & " " & esaName & ".zip "
FileNameXls = "C:\rds\zipped\" & seqNumber & " " & esaName & ".xls"
ActiveWorkbook.SaveCopyAs FileName:=FileNameXls

ShellStr = PathWinZip & "Winzip32 -min -a " _
& " " & Chr(34) & FileNameZip & Chr(34) _
& " " & Chr(34) & FileNameXls & Chr(34)
Runwzzip = Shell(ShellStr, vbHide)


nSubject = ActiveSheet.Range("b6").Value
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(olMailItem)

With OutMail
.To = "Email here"
.CC = ""
.BCC = ""
.Subject = nSubject
.Body = " "
.Attachments.Add FileNameZip
.Send


End With

Set OutMail = Nothing
Set OutApp = Nothing
Kill FileNameXls

End Sub

 

[Paul Mac]

Hi Steve,

1.You could try iterating through a collection of files passing the same Shell command, this will add each to the archive.

Something like:
Using FSO.Getfolder, you can collect all of the fso.files and add them into your collection. So if all of the workbooks are in the same folder, you can just iterate through the folder contents to get each of the files.

2. To have your created email displayed instead of sent, you just use, .display (instead of .send) in you olMessage code. This will then show the email before you send it.

Tip: With the error handling for the winzip.exe file, you can use Application.GetOpenFileName, which then you can trap & filter the file that is selected. Although this is passed through excel, you just wouldn't use the Execute Command.

I.e.
Dim strWinZip as String
strWinZip = Application.GetOpenFilename "Application Files (*.exe), *.exe"
if strWinZip = False or strWinZip = "" then
..........
else
'Use StrWinzip as the location where your file was found. Remember that strWinZip is a String.
end if

----- Steve wrote: -----

Hi hope someone can help me out
The code below will ZIP the active workbook and send the zip file via email

1. I need to insert addition files into the ZIP archive before it hits the
email
2. I need Outlook to setup the email but NOT send the file (ie I'd like to
manually press send...)

Any ideas much appeciated



Sub ActiveWorkbook_Zip_Mail()
'This sub will send a newly created workbook (copy of the Activeworkbook).
'It zip and save 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 Runwzzip As Long
Dim OutApp As Outlook.Application
Dim OutMail As Outlook.MailItem

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

esaName = ActiveSheet.Range("f6").Value
seqNumber = ActiveSheet.Range("b6").Value
FileNameZip = "C:\rds\zipped\" & seqNumber & " " & esaName & ".zip "
FileNameXls = "C:\rds\zipped\" & seqNumber & " " & esaName & ".xls"
ActiveWorkbook.SaveCopyAs FileName:=FileNameXls

ShellStr = PathWinZip & "Winzip32 -min -a " _
& " " & Chr(34) & FileNameZip & Chr(34) _
& " " & Chr(34) & FileNameXls & Chr(34)
Runwzzip = Shell(ShellStr, vbHide)


nSubject = ActiveSheet.Range("b6").Value
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(olMailItem)

With OutMail
.To = "Email here"
.CC = ""
.BCC = ""
.Subject = nSubject
.Body = " "
.Attachments.Add FileNameZip
.Send


End With

Set OutMail = Nothing
Set OutApp = Nothing
Kill FileNameXls

End Sub