Copier Déplacer des sous répertoire d'une carte SD vers un répertoire PC

Version imprimable

23/01/2015, 12h25
Lagneaux

Copier Déplacer des sous répertoire d'une carte SD vers un répertoire PC

Copier Déplacer des sous répertoire d'une carte SD vers un répertoire PC

Bonjour

Je ne sais pas comment faire un script VBS ... Sic !

Je souhaiterai automatiser le déplacement de sous-répertoires de ma carte SD (I:\DCIM\) vers un répertoire de mon PC portable (F:\missions\datas\) avec les contrôles nécessaires pour s'assurer que rien ne manques tant pour les répertoires que leurs contenus puis en cas de manque d'un ou plusieurs fichiers dans le répertoire distant le ou les copier jusqu'à que tout soit copié et pour enfin supprimer tous ce qui est sous I:\DCIM\

Un message final comme quoi tout c'est bien déroulé jusqu'au bout rassurera ...

Merci par avance pour celui ou celle qui me concoctera ce script

Meilleurs Voeux à tous les programmeurs de France et de Navarre !

Dom
24/01/2015, 13h02
l_autodidacte

Citation:

Meilleurs Vœux à tous les programmeurs de France et de Navarre !

et les autres ne le mériteraient pas ! pourtant ils peuvent aider ?
J'ai vu qu'un pro l'a déjà fait puis il s'est résigné peut-être à cause de cette phrase, je ne saurais trop le dire.

AUTOMATISER DCIM vers DD copyphoto.vbs

Bonjour,

Comment modifier ce script pour que l'arborescence sous DCIM soit maintenue ?

Merci par avance
Cordialement,

COMMENT IL FONCTIONNE
Windows a la manie de changer la lettre affectée aux volumes amovibles. Par exemple, si l'on branche un lecteur de cartes puis un disque USB, la lettre attachée à chacun d'eux va dépendre de l'ordre du branchement.

C'est assez casse-pieds, en particulier si l'on veut se faire un batch de rapatriement facile de photos numériques.

Donc l'idée de ce script est de permettre d'insérer une carte mémoire provenant d'un appareil photo dans un lecteur quelconque et d'avoir une recopie automatique vers le dossier du disque dur où vous traitez vos nouvelles images. Le seul paramètre que l'on précise (c'est même optionnel) est l'emplacement de ce dossier destination. Il n'y a pas besoin d'indiquer la source (on ne peut d'ailleurs pas le faire).

Comme vous le savez, quand un appareil photo formate ou prépare une carte, il crée un dossier DCIM puis au fur et à mesure qu'il prend des photos crée des sous-dossiers ayant un nom du genre 100_xxx où xxx varie selon la marque voire le modèle de l'appareil (par exemple 100_PANA pour un Panasonic). En général, l'appareil sauve un certain nombre de photos dans ce sous-dossier, par exemple 100, puis il crée un autre sous-dossier dans DCIM, par exemple 200_xxx et ainsi de suite. Fort heureusement, il attribue toujours un nom unique aux photos indépendamment du dossier.

Le script cherche tous les lecteurs amovibles du système et s'il y trouve un dossier DCIM (cela évite que l'on recopie autre chose que des cartes provenant d'appareils photo), il va aller dans chacun des sous-dossier tous les fichiers qui s'y trouvent et les copie dans le dossier destination à condition que le fichier n'y figure pas déjà. C'est une notion importante, le script n'efface jamais rien. Ni les fichiers de la carte mémoire ni ceux du disque dur. Je préfère de loin "oublier" sur la carte un fichier dont le nom doublonnerait (ce qui en principe ne devrait pas se produire) que d'écraser une photo sur laquelle j'ai déjà travaillé parce que j'avais oublié de vider la carte.

L'usage du script est tout simple, on ne lui passe qu'un seul paramètre, le nom de dossier de destination. Par exemple, on le lance de la manière suivante: copyphotos.vbs d:\photos\nouvelles. Si il y a des espaces dans le chemin de destination, il faut le faire figurer entre guillemets; par exemple copyphotos.vbs "d:\photos\A faire". Il ne faut PAS faire figurer de backslash (signe \) à la fin du chemin.

Le plus simple est de placer le script (fichier copyphotos.vbs) dans un dossier de votre disque dur, par exemple "d:\program files\cmd" et de créer un raccourci pour le lancer depuis le menu Démarrer. Pour cela, faire clic-droit/Ouvrir sur le menu Démarrer puis dans le dossier Programmes (ou un autre) faire clic-droit/Nouveau/Raccourci. Cliquez sur Parcourir et allez désigner le fichier copyphoto.vbs.

LE SCRIPT

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
' Jean-Claude Berger, march 2007, version 1.02
' CopyPhotos.vbs
 
' Script to copy pictures from a memory card userd with a digital camera.
' Will take all files (but not folders themselves) from all removable disks
' having a DCIM\whatever_subfolder folder (cameras create them)
' and copy them to the destination folder given as an argument 
'(or My pictures\New Pictures if none given).
' Wil NOT erease files if they are already present on destination folder
' nor will delete them from source.
 
' DISCLAIMER: This program is NOT supported (in other words, I will NOT answer 
' any question about it) and there is NO WARRANTY of any kind attached to it.
' If you lose all your data or your job, if your children, you wife and your dog
' hate you because you used it, IT'S YOUR PROBLEM, NOT MINE.
' The simple fact to think about downloading it makes up acceptance of those terms.
 
' NOTE IMPORTANTE: CE PROGRAMME EST GRATUIT ET EN TELECHARGEMENT
' LIBRE. MAIS IL NE FAIT L'OBJET D'AUCUN SUPPORT (en d'autres termes,
' je ne répondrai à aucune question le concernant) NI D'AUCUNE GARANTIE
' D'AUCUNE SORTE. SI VOUS PERDEZ TOUTES VOS DONNEES,
' SI VOUS ETES LICENCIE OU SI VOS ENFANTS ET VOTRE CHIEN
' VOUS DETESTENT SUITE A SON USAGE, 
' C'EST VOTRE PROBLEME, PAS LE MIEN.
 
' History
 
' Version 1.01
' FEATURE Added title to msgBox
 
' Version 1.02 
' BUG Splitted test (previously linked by a AND) about drive ready and existing DCIM folder. Seems VBS does not warrant evaluation
'          order of clauses linked by a AND.
 
Option Explicit
 
Dim strComputer
Dim strDestinationPath           ' Folder where the pictures should go. Will be initialized from the first parameter passed to the script
Dim SourceDir                    ' Subfolders in the DCIM folder
Dim strSourcePath                ' Path of source files
Dim objWMIService
Dim colDisks                     ' Collection of disks of the system
Dim objDisk                      ' Each disk
Dim ColSourceFiles               ' List of files to copy from
Dim SourceFile                   ' Each file to copy from
Dim objFSO
Dim strDestFile                  'Filename of destination file
Dim bolAtLeastOneDestFileExists  ' Flag for managing ignored files warning
Dim intNumFilesCopied            ' Flag to avoid Pictures copied message if none were
Dim objArgs                      ' Parameters passed to the script
Dim strIgnoredFilesList          ' List of files that where not copied because they existed on the destination folder
Dim objDrive                     '  For testing if drive is ready else we get an error on multicards readers
Dim objDCIMDir                   ' Folders DCIM on the cards           
Dim objShell
Dim objMyPicFolder               ' Object on the "My pictures" folder
 
Const strDCIMDir = "\DCIM"       ' Name of the DCIM folder cameras create in the root of cards
Const MY_PICTURES = &H27&
Const strAUTOFOLDER = "\New Pictures"
 
strComputer = "."
Set objFSO = CreateObject("Scripting.FileSystemObject")
bolAtLeastOneDestFileExists = False
intNumFilesCopied = 0
 
set objArgs = wscript.arguments
if objArgs.count < 1 then
    ' If no destination folder is given, create a "New Pictures" folder in the "My Pictures" folder of the user
    Set objShell = CreateObject("Shell.Application")
    Set objMyPicFolder = objShell.Namespace(MY_PICTURES) 
    Set objMyPicFolder = objMyPicFolder.Self  
    strDestinationPath = objMyPicFolder.path & strAUTOFOLDER
    On error resume next    ' In case folder exists
        objFSO.CreateFolder(strDestinationPath)
    On error goto 0
else
    strDestinationPath = objArgs(0)
end if
 
if not objFSO.Folderexists(strDestinationPath) then
    msgBox "The destination folder does not exists. Copy aborted." & chr(13)_
        & "Usage: " & wscript.ScriptName & " Destination_folder.", vbCritical, "Error"
    wscript.quit 1
end if
 
Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\"_
        & strComputer & "\root\cimv2")
Set colDisks = objWMIService.ExecQuery ("Select * from Win32_LogicalDisk")
For Each objDisk in colDisks
 
    if objDisk.DriveType = 2  then   ' If removable
 
        ' Must test if it is ready because an empty but connected card reader would cause errors
        ' and must test if DCIM folder exists cause there might be non "camera" removable drives
 
        Set objDrive = objFSO.getDrive(objDisk.DeviceID)
        if objDrive.isReady Then        ' Should be tested first because it seems that the order of evaluation of AND clauses if not consistent
            If objFSO.Folderexists(objDisk.DeviceID & strDCIMDir) then 
                Set objDCIMDir = objFSO.getfolder (objDisk.DeviceID & strDCIMDir)    
                ' DeviceID is the logical disk name (D: for example)
                For Each SourceDir in objDCIMDir.subFolders
 
                    strSourcePath = objDisk.DeviceID & strDCIMDir & "\" & SourceDir.name
 
                    Set ColSourceFiles = objWMIService.ExecQuery ("ASSOCIATORS OF {Win32_Directory.Name='"_
                        & strSourcePath & "'} Where ResultClass = CIM_DataFile")
                    For Each SourceFile In ColSourceFiles
 
                        ' The name property gives the full (with path) file name and the filename property gives the bare file name
 
                            strDestFile = strDestinationPath & "\" & SourceFile.FileName _
                                & "." & SourceFile.extension
 
                            If not objFSO.FileExists(strDestFile) Then
                                SourceFile.copy strDestFile, False
                                intNumFilesCopied = intNumFilesCopied + 1
                            Else
                                if bolAtLeastOneDestFileExists = False then
                                    bolAtLeastOneDestFileExists = True
                                    strIgnoredFilesList = SourceFile.Filename
                                Else
                                    strIgnoredFilesList = strIgnoredFilesList & ", " & SourceFile.Filename
                                End if
                            End If
                    Next
 
                Next
            End If  ' If has a DCIM folder
        End If      ' If isready 
    End if  ' If removable
Next
If bolAtLeastOneDestFileExists = True then
    msgbox Cstr(intNumFilesCopied) & " picture(s) copied to: " & chr(13) & strDestinationPath & "." & chr(13) &_
        "WARNING: Some files already existed in the destination folder. They were ignored."_
            & chr(13) & strIgnoredFilesList, vbExclamation, "Copy Photos"
else 
    msgbox Cstr(intNumFilesCopied) & " picture(s) copied to: " & chr(13) & strDestinationPath & ".", vbInformation, "Copy Photos"
End If
 
wscript.quit 0

Bonjour;

Il suffirait de remplacer les lignes 101 jusqu'à 112 par

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
                For Each SourceDir in objDCIMDir.subFolders
                    Dim NewDest
                    On Error Resume Next  ' pour éviter l'erreur "Le dossier existe déjà" au cas où
                    Set NewDest = objFSO.CreateFolder(strDestinationPath & "\" & SourceDir.Name)
                    strSourcePath = objDisk.DeviceID & strDCIMDir & "\" & SourceDir.name
 
                    Set ColSourceFiles = objWMIService.ExecQuery ("ASSOCIATORS OF {Win32_Directory.Name='"_
                        & strSourcePath & "'} Where ResultClass = CIM_DataFile")
                    For Each SourceFile In ColSourceFiles
 
                        ' The name property gives the full (with path) file name and the filename property gives the bare file name
 
                            strDestFile =  NewDest & "\" & SourceFile.FileName _
                                & "." & SourceFile.extension

26/01/2015, 09h07
Lagneaux

Bjr L'Autodidacte,

Un grand merci ... Cela évitera que je fasse des «C******» sur le terrain avec le PAD de mon PC portable !

Sans vous obliger, seriez-vous ajouter, en fin de script, les quelques lignes VBS qui permettront de vérifier que tout a bien été copié dans le réperoire de destination et après quoi supprimer tous les sous-répertoires se trouvant sous DCIM ?

Merci par avance ...
Cdlt
Dom

Supprimer les sous-dossier de DCIM !

Comment ajouter, en fin de script, les quelques lignes VBS qui permettraient de supprimer tous les sous-répertoires se trouvant sous \DCIM ?
Merci par avance ...

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
' Jean-Claude Berger, march 2007, version 1.02
' CopyPhotos.vbs
 
' Script to copy pictures from a memory card userd with a digital camera.
' Will take all files (but not folders themselves) from all removable disks
' having a DCIM\whatever_subfolder folder (cameras create them)
' and copy them to the destination folder given as an argument 
'(or My pictures\New Pictures if none given).
' Wil NOT erease files if they are already present on destination folder
' nor will delete them from source.
 
' DISCLAIMER: This program is NOT supported (in other words, I will NOT answer 
' any question about it) and there is NO WARRANTY of any kind attached to it.
' If you lose all your data or your job, if your children, you wife and your dog
' hate you because you used it, IT'S YOUR PROBLEM, NOT MINE.
' The simple fact to think about downloading it makes up acceptance of those terms.
 
' NOTE IMPORTANTE: CE PROGRAMME EST GRATUIT ET EN TELECHARGEMENT
' LIBRE. MAIS IL NE FAIT L'OBJET D'AUCUN SUPPORT (en d'autres termes,
' je ne répondrai à aucune question le concernant) NI D'AUCUNE GARANTIE
' D'AUCUNE SORTE. SI VOUS PERDEZ TOUTES VOS DONNEES,
' SI VOUS ETES LICENCIE OU SI VOS ENFANTS ET VOTRE CHIEN
' VOUS DETESTENT SUITE A SON USAGE, 
' C'EST VOTRE PROBLEME, PAS LE MIEN.
 
' History
 
' Version 1.01
' FEATURE Added title to msgBox
 
' Version 1.02 
' BUG Splitted test (previously linked by a AND) about drive ready and existing DCIM folder. Seems VBS does not warrant evaluation
'          order of clauses linked by a AND.
 
' Version 2.01 (by Lagneaux & L'autodidacte de devellopez.net)
' DCIM subdirectories but also their contents, are copied
' Les sous-répertoire de DCIM mais aussi leurs contenus, sont copiés 
 
 
 
Option Explicit
 
Dim strComputer
Dim strDestinationPath           ' Folder where the pictures should go. Will be initialized from the first parameter passed to the script
Dim SourceDir                    ' Subfolders in the DCIM folder
Dim strSourcePath                ' Path of source files
Dim objWMIService
Dim colDisks                     ' Collection of disks of the system
Dim objDisk                      ' Each disk
Dim ColSourceFiles               ' List of files to copy from
Dim SourceFile                   ' Each file to copy from
Dim objFSO
Dim strDestFile                  'Filename of destination file
Dim bolAtLeastOneDestFileExists  ' Flag for managing ignored files warning
Dim intNumFilesCopied            ' Flag to avoid Pictures copied message if none were
Dim objArgs                      ' Parameters passed to the script
Dim strIgnoredFilesList          ' List of files that where not copied because they existed on the destination folder
Dim objDrive                     '  For testing if drive is ready else we get an error on multicards readers
Dim objDCIMDir                   ' Folders DCIM on the cards           
Dim objShell
Dim objMyPicFolder               ' Object on the "My pictures" folder
 
Const strDCIMDir = "\DCIM"       ' Name of the DCIM folder cameras create in the root of cards
Const MY_PICTURES = &H27&
Const strAUTOFOLDER = "\New Pictures"
 
strComputer = "."
Set objFSO = CreateObject("Scripting.FileSystemObject")
bolAtLeastOneDestFileExists = False
intNumFilesCopied = 0
 
set objArgs = wscript.arguments
if objArgs.count < 1 then
    ' If no destination folder is given, create a "New Pictures" folder in the "My Pictures" folder of the user
    Set objShell = CreateObject("Shell.Application")
    Set objMyPicFolder = objShell.Namespace(MY_PICTURES) 
    Set objMyPicFolder = objMyPicFolder.Self  
    strDestinationPath = objMyPicFolder.path & strAUTOFOLDER
    On error resume next    ' In case folder exists
        objFSO.CreateFolder(strDestinationPath)
    On error goto 0
else
    strDestinationPath = objArgs(0)
end if
 
if not objFSO.Folderexists(strDestinationPath) then
    msgBox "The destination folder does not exists. Copy aborted." & chr(13)_
        & "Usage: " & wscript.ScriptName & " Destination_folder.", vbCritical, "Error"
    wscript.quit 1
end if
 
Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\"_
        & strComputer & "\root\cimv2")
Set colDisks = objWMIService.ExecQuery ("Select * from Win32_LogicalDisk")
For Each objDisk in colDisks
 
    if objDisk.DriveType = 2  then   ' If removable
 
        ' Must test if it is ready because an empty but connected card reader would cause errors
        ' and must test if DCIM folder exists cause there might be non "camera" removable drives
 
        Set objDrive = objFSO.getDrive(objDisk.DeviceID)
        if objDrive.isReady Then        ' Should be tested first because it seems that the order of evaluation of AND clauses if not consistent
            If objFSO.Folderexists(objDisk.DeviceID & strDCIMDir) then 
                Set objDCIMDir = objFSO.getfolder (objDisk.DeviceID & strDCIMDir)    
                ' DeviceID is the logical disk name (D: for example)
                For Each SourceDir in objDCIMDir.subFolders
                    Dim NewDest
                    On Error Resume Next  ' pour éviter l'erreur "Le dossier existe déjà" au cas où
                    Set NewDest = objFSO.CreateFolder(strDestinationPath & "\" & SourceDir.Name)
                    strSourcePath = objDisk.DeviceID & strDCIMDir & "\" & SourceDir.name
 
                    Set ColSourceFiles = objWMIService.ExecQuery ("ASSOCIATORS OF {Win32_Directory.Name='"_
                        & strSourcePath & "'} Where ResultClass = CIM_DataFile")
                    For Each SourceFile In ColSourceFiles
 
                        ' The name property gives the full (with path) file name and the filename property gives the bare file name
 
                            strDestFile =  NewDest & "\" & SourceFile.FileName _
                                & "." & SourceFile.extension
 
                            If not objFSO.FileExists(strDestFile) Then
                                SourceFile.copy strDestFile, False
                                intNumFilesCopied = intNumFilesCopied + 1
                            Else
                                if bolAtLeastOneDestFileExists = False then
                                    bolAtLeastOneDestFileExists = True
                                    strIgnoredFilesList = SourceFile.Filename
                                Else
                                    strIgnoredFilesList = strIgnoredFilesList & ", " & SourceFile.Filename
                                End if
                            End If
                    Next
 
                Next
            End If  ' If has a DCIM folder
        End If      ' If isready 
    End if  ' If removable
Next
If bolAtLeastOneDestFileExists = True then
    msgbox Cstr(intNumFilesCopied) & " picture(s) copied to: " & chr(13) & strDestinationPath & "." & chr(13) &_
        "WARNING: Some files already existed in the destination folder. They were ignored."_
            & chr(13) & strIgnoredFilesList, vbExclamation, "Copy Photos"
else 
    msgbox Cstr(intNumFilesCopied) & " picture(s) copied to: " & chr(13) & strDestinationPath & ".", vbInformation, "Copy Photos"
End If
 
wscript.quit 0

31/01/2015, 14h56
l_autodidacte

Bonjour;

Moi par exemple(et les autres je suppose), je ne réponds à ta question que si tu remets la signature(tout le commentaire placé au début du script) de l'auteur; sinon cela serait du plagiat pur et simple. Chose qu'on ne peut et ne doit accepter ni tolérer sur ce forum.
31/01/2015, 18h55
Lagneaux

Bonjour l_autodidacte

JE SUIS À 100% D'ACCORD AVEC CE QUE VOUS DITES ...

Citation:

Envoyé par l_autodidacte

Bonjour;

Moi par exemple(et les autres je suppose), je ne réponds à ta question que si tu remets la signature(tout le commentaire placé au début du script) de l'auteur; sinon cela serait du plagiat pur et simple. Chose qu'on ne peut et ne doit accepter ni tolérer sur ce forum.

J'ai retirer l'entête sans réfléchir ou penser à mal !!! Le copier/coller du code !!!! ...

J'ai modifié mon précédent message ...

Cdlt

Maintenant que tout est rentré dans l'ordre, je te suggère ceci :
1 - Ajoute aux déclarations existantes une variable qui recevra le nom du dossier source par exemple Dim MaSource et une autre pour recevoir celui du dossier cible par exemple Dim Destination.
2 - Juste sous la ligne où il y a : Set objDCIMDir = objFSO.getfolder (objDisk.DeviceID & strDCIMDir),
mets le code : MaSource = objDCIMDir.Path.
3 - A la fin du script et juste avant wscript.quit 0, place ce
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 'Simple vérivication de la taille des dossiers source et destination : Dim oRep Destination = strDestinationPath If objFSO.GetFolder(MaSource).Size = objFSO.GetFolder(Destination).Size Then If MsgBox("Les 2 dossiers ont la même taille;" & vbCrLf & "Supprimer le contenu du dossier source ?", vbYesNo) = vbYes Then For Each oRep In objFSO.GetFolder(MaSource).SubFolders ' On supprime les sous-dossiers de DCIM objFSO.DeleteFolder oRep.Path, True Next Else WScript.Quit 0 End If End If