codigo sendmail zip

22/06/2005 - 20:21 por JAVIER | Informe spam
alguien de ustedes ha podido usar este codigo con un compresor Gratutito??

Sub ActiveWorkbook_halZip_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

strdate = Format(Now, "dd-mm-yy h-mm-ss")

PathWinZip = "C:\archivos de programa\halzip\" ' Be sure that this is
the path where WinZip is installed.

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 & "halzip -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 = "jrodrigu@grupolala.com "

.CC = ""

.BCC = ""

.Subject = "ZipMailTest"

.Body = "Here is the File"

.Attachments.Add FileNameZip--> ¡¡cuando llego aqui me dice qeu el
sistem ano puede encontrar el archivo!!...

.Send

End With

Set OutMail = Nothing

Set OutApp = Nothing

Kill FileNameZip

Kill FileNameXls

End Sub
 

Leer las respuestas

#1 JAVIER
24/06/2005 - 17:54 | Informe spam
En efecto es el shell pero el detalle es como puedo solucionar esto dado que
el autor comenta que con winzip si funciona siempre y cuando tenga uno la
licencia, orita estoy intentando que funcione esta aplicacion con un
compresor gratuito pero hasta el momento no logro configurar la mcro el zi
que utilizo ahora es zipgenius 5
www.zipgenius.it
si tu sabes de algun otro compresor elcualpueda hacer funcionar esta macro
te agradeceria muchisimo!! saludos


"Manuel Romero" escribió:

Estas seguro de que tu programa de compresion funciona? todo apunta a que el
error esta en el Shell porque no esta comprimiendo

"JAVIER" escribió en el mensaje
news:
> alguien de ustedes ha podido usar este codigo con un compresor Gratutito??
>
> Sub ActiveWorkbook_zipMail()
>
> '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
>
> strdate = Format(Now, "dd-mm-yy h-mm-ss")
>
> PathWinZip = "C:\archivos de programa\zipgenius 5\" ' Be sure that this
> is
> the path where WinZip is installed.
>
> 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 & "zipgenius -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 = " "
>
> .CC = ""
>
> .BCC = ""
>
> .Subject = "ZipMailTest"
>
> .Body = "Here is the File"
>
> .Attachments.Add FileNameZip--> ¡¡cuando llego aqui me dice qeu el
> sistem ano puede encontrar el archivo!!...
>
> .Send
>
> End With
>
> Set OutMail = Nothing
>
> Set OutApp = Nothing
>
> Kill FileNameZip
>
> Kill FileNameXls
>
> End Sub
>
>
>
>



Preguntas similares