Bonjour,

Je suis entrain de faire un petit outil pour sauver mes données mais je rencontre un problème.
Je veux copier tout les fichiers doc qui se situe dans Mes documents
J'arrive a copier ce qui est à la racine / dans un sous répertoire mais pas dans un sous-sous répertoire.

J'ai essayé un script dans les FAQ pour créer une arborescence mais je n'y arrive pas.
voila mon script
Code : Sélectionner tout - Visualiser dans une fenêtre à part
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
 
'Fenêtre pour choisir repertoire cible de sauvegarde
Const WINDOW_HANDLE = 0
Const NO_OPTIONS = 0
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder _
    (WINDOW_HANDLE, "Select a folder:", NO_OPTIONS, "C:\Scripts")       
Set objFolderItem = objFolder.Self
objPath = objFolderItem.Path & "\"
 
Set objFS = CreateObject("Scripting.FileSystemObject")
strFolder_MesDoc=CreateObject("WScript.Shell").ExpandEnvironmentStrings("%UserProfile%\Mes documents\")
 
Set objFolder = objFS.GetFolder(strFolder_MesDoc)
 
'fonction pour lister / copier les fichiers doc docx
 
Sub Godoc(objDIR)
 
If objDIR <> "\System Volume Information" Then
	For Each eFolder in objDIR.SubFolders   	
		Godoc eFolder
	Next
	For Each strFile In objDIR.Files
 
		strFileName = strFile.Name
		strExtension = objFS.GetExtensionName(strFile)
		If strExtension = "doc" Then
			objPath2 =  MesDoc & "\" & objDIR.name & "\"
 
 
'Création des repertoires présents dans mes documents dans la repertoire de sauvegarde.
Set oFSO = CreateObject("Scripting.FileSystemObject")
If oFSO.FolderExists(objPath2) Then
else
Dim oFld 
'Crée le repertoire
Set oFld=oFSO.CreateFolder (objPath2)
End IF
 
objFS.CopyFile strFile , objPath2 & strFileName
else 
If strExtension = "docx" Then
objFS.CopyFile strFile , objPath2 & strFileName
End If
End If
Next    
End If  
End Sub