VBscript pour zipper dossier

Question

Bonjour le forum 
Malgré mes nombresuses recherches, je n' ai pas trouvé ce que je voulais. je suis à la recherche d' un code en vbscript pour zipper un dossier. Le pb c' est que le dossier est sur un disque externe et que la lettre de lecteur change lors des connexions au divers PC. Je n' arrive pas à trouvé un code avec une imput box pour indiquer le chemin du dossier et une autre pour indique la destinantion 
Merci d' avance de vore aide
Aladin

cs_loulou69 · Answer

Bonjour 

Tu auras dans mon code quelques lignes à reprendre
Je n'ai pas traiter le zip d'un répertoire mais la copie de tous les fichiers d'un répertoire sur une clé USB détecté comme le premier disque de type en partant du lecteur C:

' copier tous les fichiers du dossier sélectionné vers la clé USB

Const OverwriteExisting = TRUE
Dim strComputer
Dim colDrives
Dim objDrive
Dim strExternalDrive
Dim strTarget 
Dim oFolder
Dim colFiles
Dim oFile

Set objFSO = CreateObject("Scripting.FileSystemObject")

strComputer = "."
Set objWMIService = GetObject("winmgmts:\" & strComputer & "\root\cimv2")
'DriveType=2 liste des lecteurs externes
Set colDrives = objWMIService.ExecQuery _
    ("Select * From Win32_LogicalDisk Where DriveType = 2")

sFolder= GetScriptShellFolder
For Each objDrive in colDrives
strExternalDrive = Cstr(objDrive.DeviceID)
strTarget = strExternalDrive & "" 
strTarget = strTarget & Replace(Date,"/","_") 
if Ucase(Mid(strTarget,1,1))>="C" Then
Msgbox strTarget 

'objFso.CreateFolder strTarget
Set oFolder= objFso.GetFolder(sFolder)
set colFiles= oFolder.Files
 MsgBox colFiles.Count
For Each oFile in colFiles
Msgbox sFolder & "" & oFile.name & "->" & strTarget
  objFSO.CopyFile sFolder & "" & oFile.name, strTarget & "" & oFile.Name, OverWriteExisting
Next
end if
Next

Public Function GetScriptShellFolder()
Const MY_COMPUTER = &H11&
Const WINDOW_HANDLE = 0
Const options = 0
Dim objShell
Dim objFolder
Dim objFolderItem

Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.Namespace(&H11)
Set objFolderItem = objFolder.self
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(WINDOW_HANDLE, "sélectionnez le dossier destination", options, objFolderItem.Path)
If objFolder Is Nothing Then  Wscript.Quit
GetScriptShellFolder = objFolder.self.Path
Set objFolderItem = Nothing
Set objFolder = Nothing
Set objShell = Nothing
End Function


Courage pour la suite

cs_barada · Answer

Bonjour loulou69 et le forum 
Merci pour ta réponse, j' éssayerai de l' adapté et te tiendra informé du résultat 
barada

VBscript pour zipper dossier

2 réponses

Votre réponse

Discussions similaires