J
john
Help me please with this:
I have microsoft office 2000 MS exchange and winzip32.exe.
How can I modify this macro?
Thansk
-----
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
strdate = Format(Now, "dd-mm-yy h-mm-ss")
FileNameZip = "C:\" & Left(ActiveWorkbook.Name, Len
(ActiveWorkbook.Name) - 4) & " " & strdate & ".zip "
FileNameXls = "C:\" & Left(ActiveWorkbook.Name, Len
(ActiveWorkbook.Name) - 4) & " " & strdate & ".xls"
ActiveWorkbook.SaveCopyAs FileName:=FileNameXls
ShellStr = PathWinZip & "Winzip32 -min -a " _
& " " & Chr(34) & FileNameZip & Chr(34) _
& " " & Chr(34) & FileNameXls & Chr(34)
Runwzzip = Shell(ShellStr, vbHide)
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(olMailItem)
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
Kill FileNameZip
Kill FileNameXls
End Sub
I have microsoft office 2000 MS exchange and winzip32.exe.
How can I modify this macro?
Thansk
-----
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
strdate = Format(Now, "dd-mm-yy h-mm-ss")
FileNameZip = "C:\" & Left(ActiveWorkbook.Name, Len
(ActiveWorkbook.Name) - 4) & " " & strdate & ".zip "
FileNameXls = "C:\" & Left(ActiveWorkbook.Name, Len
(ActiveWorkbook.Name) - 4) & " " & strdate & ".xls"
ActiveWorkbook.SaveCopyAs FileName:=FileNameXls
ShellStr = PathWinZip & "Winzip32 -min -a " _
& " " & Chr(34) & FileNameZip & Chr(34) _
& " " & Chr(34) & FileNameXls & Chr(34)
Runwzzip = Shell(ShellStr, vbHide)
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(olMailItem)
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
Kill FileNameZip
Kill FileNameXls
End Sub