Google Groups no longer supports new Usenet posts or subscriptions. Historical content remains viewable.
Dismiss

zippare un file con vba

1,079 views
Skip to first unread message

ale

unread,
Jun 24, 2010, 10:01:20 AM6/24/10
to
In questo modo, riesco a copiarmi un singolo foglio, salvarlo e
tornare dove stavo lavorando:
Dim C1 As String
C1 = "Forecast Milano"
Sheets("Milano").Select
Sheets("Milano").Copy
percorso = "C:\Documenti\"
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=percorso & C1 & ".xls" _
, FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
Application.DisplayAlerts = True
ActiveWindow.Close

E' possibile, oltre a salvarlo, ritrovarmi il file già zippato così è
pronto per inviarlo via mail?
Ho trovato qui
http://www.rondebruin.nl/windowsxpzip.htm
qualcosa..ma non riesco a capire.
Qualcuno può aiutarmi?
Grazie
Ciao
Ale

Message has been deleted

ale

unread,
Jun 24, 2010, 11:26:34 AM6/24/10
to
On 24 Giu, 16:26, "Mauro Gamberini"

<maurogscRIMUOV...@RIMUOVEREaliceposta.it> wrote:
> > E' possibile, oltre a salvarlo, ritrovarmi il file già zippato così è
> > pronto per inviarlo via mail?
> > Ho trovato qui
> >http://www.rondebruin.nl/windowsxpzip.htm
> > qualcosa..ma non riesco a capire.
>
> Cosa non capisci?
>
> --
> ---------------------------
> Mauro Gamberini
> Microsoft MVP - Excelhttp://www.riolab.org/http://www.maurogsc.eu/http://social.answers.microsoft.com/Forums/it-IT/officeexcelit/threads

Non capisco esattamente qual'è l'istruzione che devo inserire. Subito
dopo aver scritto il mio
ActiveWorkbook.SaveAs ....
cosa devo inserire.
Grazie
Ale

Mauro Gamberini

unread,
Jun 24, 2010, 12:57:34 PM6/24/10
to
Non capisco esattamente qual'č l'istruzione che devo inserire. Subito

dopo aver scritto il mio
ActiveWorkbook.SaveAs ....
cosa devo inserire.
Grazie
Ale
************************************

Immagino tu debba chiamare questa
(sempre restando al link postato):
Zip the ActiveWorkbook

Ma hai letto bene(e capito) l'articolo?

__________ Informazioni da ESET NOD32 Antivirus, versione del database delle firme digitali 5223 (20100623) __________

Il messaggio č stato controllato da ESET NOD32 Antivirus.

www.nod32.it


ale

unread,
Jun 25, 2010, 3:27:38 AM6/25/10
to
On 24 Giu, 18:57, "Mauro Gamberini"
<maurogscRIMUOV...@RIMUOVEREaliceposta.it> wrote:
> Non capisco esattamente qual' l'istruzione che devo inserire. Subito

> dopo aver scritto il mio
> ActiveWorkbook.SaveAs ....
> cosa devo inserire.
> Grazie
> Ale
> ************************************
>
> Immagino tu debba chiamare questa
> (sempre restando al link postato):
> Zip the ActiveWorkbook
>
> Ma hai letto bene(e capito) l'articolo?
>
> --
> ---------------------------
> Mauro Gamberini
> Microsoft MVP - Excelhttp://www.riolab.org/http://www.maurogsc.eu/http://social.answers.microsoft.com/Forums/it-IT/officeexcelit/threads

>
> __________ Informazioni da ESET NOD32 Antivirus, versione del database delle firme digitali 5223 (20100623) __________
>
> Il messaggio stato controllato da ESET NOD32 Antivirus.
>
> www.nod32.it

Il mio problema (uno dei tanti) è che con l'inglese non ci faccio
tanto...ho provato a modificare qualcosa. Ho preso come esempio
"Zip all files in the folder that you enter in the code"
perchè devo zippare dei file specifici.

e modificandolo ho fatto questo:

Sub Zip()
Dim FileNameZip, FolderName
Dim strDate As String, DefPath As String
Dim oApp As Object

DefPath = "C:\Documenti" '****l'ho cambiato
If Right(DefPath, 1) <> "\" Then
DefPath = DefPath & "\"
End If

FolderName = "C:\Documenti\test\"
'****l'ho cambiato

strDate = Format(Now, " dd-mmm-yy h-mm-ss")
FileNameZip = DefPath & "Forecast HO" & strDate & ".zip"
'****l'ho cambiato

'Create empty Zip File
NewZip (FileNameZip)

Set oApp = CreateObject("Shell.Application")
'Copy the files to the compressed folder
oApp.Namespace(FileNameZip).CopyHere
oApp.Namespace(FolderName).items

'Keep script waiting until Compressing is done
On Error Resume Next
Do Until oApp.Namespace(FileNameZip).items.Count = _
oApp.Namespace(FolderName).items.Count
Application.Wait (Now + TimeValue("0:00:01"))
Loop
On Error GoTo 0

MsgBox "You find the zipfile here: " & FileNameZip
End Sub

però mi da errore di compilazione...
Dovrei cambiare altro...oppure ho sbagliato a modificare qualcosa?
vabè.
ciao
ale

Mauro Gamberini

unread,
Jun 25, 2010, 3:34:26 AM6/25/10
to
> perņ mi da errore di compilazione...
>

A quale riga da l'errore?

--
---------------------------
Mauro Gamberini

ale

unread,
Jun 25, 2010, 3:39:15 AM6/25/10
to
On 25 Giu, 09:34, "Mauro Gamberini"
<maurogscRIMUOV...@RIMUOVEREaliceposta.it> wrote:
> > però mi da errore di compilazione...

Mi da
"errore di compilazione (sub o Function non definita)"
alla riga
NewZip (FileNameZip)
e forse è anche ovvio...
che vuol dire creare un file vuoto?
ciao
ale

ale

unread,
Jun 25, 2010, 4:19:11 AM6/25/10
to
On 25 Giu, 09:39, ale <ale_car...@hotmail.com> wrote:
> On 25 Giu, 09:34, "Mauro Gamberini"
>
> <maurogscRIMUOV...@RIMUOVEREaliceposta.it> wrote:
> > > però mi da errore di compilazione...
>
> > A quale riga da l'errore?
>
> > --
> > ---------------------------
> > Mauro Gamberini
> > Microsoft MVP - Excelhttp://www.riolab.org/http://www.maurogsc.eu/http://social.answers.mi...

>
> Mi da
> "errore di compilazione (sub o Function non definita)"
> alla riga
> NewZip (FileNameZip)
> e forse è anche ovvio...
> che vuol dire creare un file vuoto?
> ciao
> ale

Ciao Mauro,
piano piano ci sono...ecco dove sono arrivato...ho cambiato esempio
utilizzando quello che mi avevi indicato.L'errore precedente era
dovuto al fatto che non avevo incollato le sub e funtion
iniziali...ora ho fatto questo;

Sub NewZip(sPath)
'Create empty Zip File
'Changed by 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
' Rob Bovey
On Error Resume Next
bIsBookOpen = Not (Application.Workbooks(szBookName) Is Nothing)
End Function


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

Sub Zip()
Dim FileNameZip, FolderName
Dim strDate As String, DefPath As String
Dim oApp As Object

DefPath = "C:\Documenti"


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

FolderName = "C:\Documenti\test\" '<< Change

strDate = Format(Now, " dd-mmm-yy")
FileNameZip = DefPath & "Forecast HO" & " del " & strDate & ".zip"

'Create empty Zip File
NewZip (FileNameZip)

Set oApp = CreateObject("Shell.Application")
'Copy the files to the compressed folder
oApp.Namespace(FileNameZip).CopyHere
oApp.Namespace(FolderName).items

'Keep script waiting until Compressing is done
On Error Resume Next
Do Until oApp.Namespace(FileNameZip).items.Count = _
oApp.Namespace(FolderName).items.Count
Application.Wait (Now + TimeValue("0:00:01"))
Loop
On Error GoTo 0

MsgBox "You find the zipfile here: " & FileNameZip
End Sub

come vedi (rispetto all'originale) gli ho tolto l'orario (va bene
anche solo avere la data). Però mi da errore:
"variabile oggetto o blocco with non impostata" sulla riga
oApp.Namespace(FileNameZip).CopyHere oApp.Namespace(FolderName).items
puoi aiutarmi...
Grazie come sempre.
Ciao
Ale

Mauro Gamberini

unread,
Jun 25, 2010, 4:29:40 AM6/25/10
to
> come vedi (rispetto all'originale) gli ho tolto l'orario (va bene
> anche solo avere la data). Perň mi da errore:

> "variabile oggetto o blocco with non impostata" sulla riga
> oApp.Namespace(FileNameZip).CopyHere oApp.Namespace(FolderName).items
> puoi aiutarmi...
>

Prima prova cosě.
Vai alla pagina di Ron con IE.
Click sulla pagina con il tasto dx del mouse.
Seleziona: traduci con Bing.

--
---------------------------
Mauro Gamberini

ale

unread,
Jun 25, 2010, 4:44:48 AM6/25/10
to
On 25 Giu, 10:29, "Mauro Gamberini"

<maurogscRIMUOV...@RIMUOVEREaliceposta.it> wrote:
> > come vedi (rispetto all'originale) gli ho tolto l'orario (va bene
> > anche solo avere la data). Però mi da errore:

> > "variabile oggetto o blocco with non impostata" sulla riga
> > oApp.Namespace(FileNameZip).CopyHere oApp.Namespace(FolderName).items
> > puoi aiutarmi...
>
> Prima prova così.

> Vai alla pagina di Ron con IE.
> Click sulla pagina con il tasto dx del mouse.
> Seleziona: traduci con Bing.
>
> --
> ---------------------------
> Mauro Gamberini
> Microsoft MVP - Excelhttp://www.riolab.org/http://www.maurogsc.eu/http://social.answers.microsoft.com/Forums/it-IT/officeexcelit/threads

Si già fatto...ed infatti sono arrivato a questa conclusione. Con
questo codice riesco a zippare una cartella intera (ed è già qualcosa
ma non quello che vorrei).

Sub NewZip(sPath)
'Create empty Zip File
'Changed by 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

Sub Zip_All_Files_in_Folder()


Dim FileNameZip, FolderName
Dim strDate As String, DefPath As String
Dim oApp As Object

DefPath = Application.DefaultFilePath


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

FolderName = "C:\Documenti\p" '<< Change

strDate = Format(Now, " dd-mmm-yy h-mm-ss")
FileNameZip = DefPath & "MyFilesZip " & strDate & ".zip"

'Create empty Zip File
NewZip (FileNameZip)

Set oApp = CreateObject("Shell.Application")
'Copy the files to the compressed folder
oApp.Namespace(FileNameZip).CopyHere
oApp.Namespace(FolderName).items

'Keep script waiting until Compressing is done
On Error Resume Next
Do Until oApp.Namespace(FileNameZip).items.Count = _
oApp.Namespace(FolderName).items.Count
Application.Wait (Now + TimeValue("0:00:01"))
Loop
On Error GoTo 0

MsgBox "You find the zipfile here: " & FileNameZip
End Sub

Io vorrei poter indicare nel codice dei singoli file e zipparli uno ad
uno.
Ciao
Ale

Mauro Gamberini

unread,
Jun 25, 2010, 4:58:18 AM6/25/10
to
> Io vorrei poter indicare nel codice dei singoli file e zipparli uno ad
> uno.
>

Non se se sia possibile con il
codice alla pagina a cui fai riferimento.
Mi spiace ma non ho molto tempo.
Se per cartella intendi una cartella di Windows,
crea una cartella(MkDir nella guida del vb di Excel),
salvaci il file, zippa la cartella.
Cicla per i singoli file.
Ovviamente puoi controllare se la cartella esiste già e
comportarti di conseguenza, esempio:

Public Sub m()

Dim objFso As Object
Dim objFolder As Object
Set objFso = CreateObject("Scripting.FileSystemObject")

If objFso.FolderExists("C:\Backup PC\Personale\") Then
MsgBox "La cartella esiste"
'codice di rimozione cartella, vedi RmDir
Else
MsgBox "La cartella non esiste"
'creo la cartella con MkDir, oppure
Set objFolder = objFso.CreateFolder("C:\Backup PC\")
Set objFolder = objFso.CreateFolder("C:\Backup PC\Personale\")
MsgBox "La cartella è stata creata"
End If

Set objFolder = Nothing
Set objFso = Nothing

End Sub

Per eliminare una cartella vedi RmDir sempre nella guida del vb di Excel.

--
---------------------------
Mauro Gamberini

ale

unread,
Jun 25, 2010, 5:12:28 AM6/25/10
to
On 25 Giu, 10:58, "Mauro Gamberini"

Va benissimo...grazie per la disponibililtà...non voglio farti perdere
del tempo...
Cmq penso di esser sulla strada giusta. Ho preso l'esempio dello zip
di un file scelto con il browse e se riuscissi a cambiare questa riga

FName = Application.GetOpenFilename(filefilter:="Excel Files (*.xl*),
*.xl*", _
MultiSelect:=True, Title:="Select the files you
want to zip")

con il file specifico...
Alla prox
Ciao
Ale

Mauro Gamberini

unread,
Jun 25, 2010, 5:39:50 AM6/25/10
to
> Cmq penso di esser sulla strada giusta. Ho preso l'esempio dello zip
> di un file scelto con il browse e se riuscissi a cambiare questa riga
>

Forse non c'entra nulla ma
perchč non utilizzi Winzip(la versione 8 va benissimo)
http://web.tiscalinet.it/psgbaseball/winzip.html

Mooolto piů semplice zippare un file:
http://forum.masterdrive.it/ms-office-access-vba-23/zippare-file-vba-4396/

si discute di Word ma con excel cambia solo il riferimento al tipo di file.

--
---------------------------
Mauro Gamberini

ale

unread,
Jun 25, 2010, 5:51:22 AM6/25/10
to
On 25 Giu, 11:39, "Mauro Gamberini"
<maurogscRIMUOV...@RIMUOVEREaliceposta.it> wrote:
> > Cmq penso di esser sulla strada giusta. Ho preso l'esempio dello zip
> > di un file scelto con il browse e se riuscissi a cambiare questa riga
>
> Forse non c'entra nulla ma
> perchè non utilizzi Winzip(la versione 8 va benissimo)http://web.tiscalinet.it/psgbaseball/winzip.html
>
> Mooolto più semplice zippare un file:http://forum.masterdrive.it/ms-office-access-vba-23/zippare-file-vba-...

>
> si discute di Word ma con excel cambia solo il riferimento al tipo di file.
>
> --
> ---------------------------
> Mauro Gamberini
> Microsoft MVP - Excelhttp://www.riolab.org/http://www.maurogsc.eu/http://social.answers.microsoft.com/Forums/it-IT/officeexcelit/threads

ci provo...grazie ancora
ciao
ale

0 new messages