Macro to Zip open Word document...

[Conder]

...and email it.

Hello,

New on here, I've done a search and not been able to find the answer so I hope someone can help.

I need to create a Macro to Zip and email and open document. Anyone got any ideas?

I've managed to do it in Excel but the code doesn't carry over to Word. I'm affriad it's just a Cut and Paste job as I have no VBA skills.

Thanks in advance.

[fumei]

Post your Excel code.

[Conder]

ub Zip_Mail_ActiveWorkbook()
Dim strDate As String, DefPath As String, strbody As String
Dim oApp As Object, OutApp As Object, OutMail As Object
Dim FileNameZip, FileNameXls

DefPath = Application.DefaultFilePath
If Right(DefPath, 1) <> "\" Then
DefPath = DefPath & "\"
End If

'Create date/time string and the temporary xls/zip file names
strDate = Format(Now, " dd-mmm-yy h-mm-ss")
FileNameZip = DefPath & Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 4) & strDate & ".zip"
FileNameXls = DefPath & Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 4) & strDate & ".xls"

If Dir(FileNameZip) = "" And Dir(FileNameXls) = "" Then

'Make copy of the activeworkbook
ActiveWorkbook.SaveCopyAs FileNameXls

'Create empty Zip File
NewZip (FileNameZip)

'Copy the file in 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

'Create the mail
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
strbody = "Zip file"
On Error Resume Next
With OutMail
.To = ""
.CC = ""
.BCC = ""
.Subject = "Zipped Excel File"
.Body = strbody
.Attachments.Add FileNameZip
.Display
End With
On Error GoTo 0

Set OutMail = Nothing
Set OutApp = Nothing
Set oApp = Nothing

'Delete the temporary xls file and zip file you send
Kill FileNameZip
Kill FileNameXls
Else
MsgBox "FileNameZip or/and FileNameXls exist"
End If
End Sub




Sub NewZip(sPath)
'Create empty Zip File
'keepITcool Dec-12-2005
If Len(Dir(sPath)) > 0 Then Kill sPath
Open sPath For Output As #1
Print #1, Chr$(80) & Chr$(75) & Chr$(5) & Chr$(6) & String(18, 0)
Close #1
End Sub


Function bIsBookOpen(ByRef szBookName As String) As Boolean
On Error Resume Next
bIsBookOpen = Not (Application.Workbooks(szBookName) Is Nothing)
End Function

Function Split97(sStr As Variant, sdelim As String) As Variant
Split97 = Evaluate("{""" & _
Application.Substitute(sStr, sdelim, """,""") & """}")
End Function

[fumei]

Could you explain:Open sPath For Output As #1
Print #1, Chr$(80) & Chr$(75) & Chr$(5) & Chr$(6) & String(18, 0)
Close #1

[Conder]

Haven't got a clue, as I said it's a Cut & Paste job.

[TonyJollans]

Although I can't quickly square it, it creates an empty zip archive. For full details, see http://www.pkware.com/business_and_developers/developer/appnote/

[TonyJollans]

The good news is that this can (probably) be done!

There are some differences between Excel and Word - two of consequence. Word doesn't have a Wait command but that can be worked around.

The other issue is that Word does not have a SaveCopyAs feature.

Doing a normal SaveAs will change the document being edited to that Saved As document so that (a) it cannot be deleted by the process and (b) users would have to explicitly save it as the original name to save their edits later. This can be overcome but only by saving the current document so that users won't then be able to discard their edits later. I suspect that none of this may be ideal.

The active document can be copied to a new document and saved under a new name. The only downside to that is that any VBA in the document has to be specially handled and the capacity to do that can be blocked by user setting in Word 2003 (and 2002 maybe).

If you can confirm that there will be no VBA in the documents being e-mailed (or that any VBA content need not be e-mailed with the document) then I recommend the new document approach. If not I think there will have to be some compromise. Let us know.