ZIP a la racine d'un répertoire

Le
---DGI972---
Bonjour à tous

J'aurais besoin d'un petit coup de pouce
je dois zipper un répertoire (C:1) et son contenu (sous répertoire et
fichier) et l'envoyer en ftp.
Mon vbs fonctionne presque comme je veux sauf que il ne prends pas en
compte le répertoire racine 01 qui doit compris dans le zip, et là je
galère
par ex:
c:12008052910110101.tif
c:12008052910110102.tif
c:12008052920110201.tif

le zip doit être de la forme 01AAAAMMJJ.zip et il doit contenir tous le
contenu du répertoire 01 avec le 01.

Merci d'avance voilà
mon vbs (beaucoup de pêche à la google)

Option Explicit
Dim ZipFile, SrcFldrs, Fldr, cde1, cde2, cde3, cde4, oShell
Dim Z, DA, DM, DJ
Const FOF_CREATEPROGRESSDLG = &H0&
SrcFldrs = Array("C:1")
DA=Year(Now)
DM=Month(Now)
If DM < 10 Then DM="0" & DM 'Pour fabriquer le mois sur 2 caractères
DJÚy(Now)
If DJ < 10 Then DJ="0" & DJ 'Pour fabriquer le jour sur 2 caractères
Z="01"&DA&DM&DJ
ZipFile = "C:"&Z&".zip"

'Create empty Zip File
CreateObject("Scripting.FileSystemObject") _
.CreateTextFile(ZipFile, True) _
.Write "PK" & Chr(5) & Chr(6) & String(18, vbNullChar)
With CreateObject("Shell.Application")
For each Fldr in SrcFldrs
'Copy the files to the compressed folder
.NameSpace(ZipFile).CopyHere .NameSpace(Fldr).Items,
FOF_CREATEPROGRESSDLG
'Keep script waiting until Compressing is done
On Error Resume Next
Do Until .NameSpace(ZipFile).Items.Count =
.NameSpace(Fldr).Items.Count
wScript.Sleep 3000
Loop
On Error GoTo 0
Next
End With

msgbox "Le fichier Zip "& ZipFile & " a ete cree"

call FTP("open 192.168.15.150^toto^toto^hash^bin^put
C:1.zip^close^bye")

msgbox "Le fichier Zip a ete envoye en ftp"

cde1 = "%comspec% /C xcopy c:1*.* c:BKUP /S /Y"
cde2 = "%comspec% /C del c:1????????.zip /Q"
cde3 = "%comspec% /C rd c:1 /S /Q"
cde4 = "%comspec% /C md c:1"
Set oShell = CreateObject ("WScript.Shell")
oShell.run cde1, 0, True
oShell.run cde2, 0, True
oShell.run cde3, 0, True
oShell.run cde4, 0, True

msgbox "Le fichier Zip " & ZipFile & " a ete suprime et l'archivage de
la journee a ete effectuee dans:"&vbcrlf&vbcrlf&_
" C:BCKUP"

Function FTP(command)
Const cFTP = "FTP.txt"
Const cLOG = "FTP.log"
Const cWSS = "%comspec% /C FTP -i -s:"
Dim strOTF
strOTF = Replace(command,"^",vbCrLf)
Dim objFSO
Dim objOTF
Dim objWSS
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objOTF = objFSO.OpenTextFile(cFTP,2,True)
objOTF.Write(strOTF)
Set objOTF = Nothing
Set objFSO = Nothing
Set objWSS = CreateObject("WScript.Shell")
objWSS.Run cWSS & cFTP & " > " & cLOG,2,True
Set objWSS = Nothing
' pour debug MsgBox strOTF,vbInformation,cFTP
End Function
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
Gilles LAURENT [MVP]
Le #6737301
"---DGI972---" wrote:

Bonjour à tous


Bonjour,

J'aurais besoin d'un petit coup de pouce ...
[...]


Pour prendre en compte le dossier racine dans l'archive compressée, il
suffit d'utiliser le Namespace racine comme origine du zip.

--- Coupez ici : ZipFolder.vbs ---
rootFldr="C:1"
ZipFile="C:toto.zip"

CreateObject("Scripting.FileSystemObject") _
.CreateTextFile(ZipFile, True) _
.Write "PK" & Chr(5) & Chr(6) & String(18,VBNullChar)

With CreateObject("Shell.Application")
.NameSpace(ZipFile).CopyHere .NameSpace(rootFldr)
On Error Resume Next
Do Until .NameSpace(ZipFile).Items.Count = 1
WScript.Sleep(1000)
Loop
On Error Goto 0
End With
--- Coupez ici : ZipFolder.vbs ---

--
Gilles LAURENT
MVP Windows Server - Admin Frameworks
http://glsft.free.fr

---DGI972---
Le #6740221
"---DGI972---" wrote:

Bonjour à tous


Bonjour,

J'aurais besoin d'un petit coup de pouce ...
[...]


Pour prendre en compte le dossier racine dans l'archive compressée, il
suffit d'utiliser le Namespace racine comme origine du zip.

--- Coupez ici : ZipFolder.vbs ---
rootFldr="C:1"
ZipFile="C:toto.zip"

CreateObject("Scripting.FileSystemObject") _
.CreateTextFile(ZipFile, True) _
.Write "PK" & Chr(5) & Chr(6) & String(18,VBNullChar)

With CreateObject("Shell.Application")
.NameSpace(ZipFile).CopyHere .NameSpace(rootFldr)
On Error Resume Next
Do Until .NameSpace(ZipFile).Items.Count = 1
WScript.Sleep(1000)
Loop
On Error Goto 0
End With
--- Coupez ici : ZipFolder.vbs ---


Que dire ....

Un énorme merci déjà
Et puis que cela fonctionne exactement comme je le souhaitais.

Bonne journée à vous M LAURENT
:oÞ


Gilles LAURENT [MVP]
Le #6743401
"---DGI972---" message de
news:

| Bonne journée à vous M LAURENT

Bonne journée à vous également M ---DGI972--- :-)

--
Gilles LAURENT
MVP Windows Server - Admin Frameworks
http://glsft.free.fr
Publicité
Poster une réponse
Anonyme