Fonction rechercher et déplacer Erreur :(
Voili Voili
Je suis en train d'écrire un script vbs pour trouver des fichiers ayant une extension précise dans une arborescence donnée par un fichier liste.txt
Je pensais mon Code fini mais j'ai une erreur et je ne sais pas comment la corriger, ni quel est mon erreur
elle se trouverait dans la fonction Déplacement de fichier à
Code:
1
2
|
Set MyPath = ObjFSO.GetFolder(CheminFichier) |
le programme me dit que le chemin est introuvable...
si quelqu'un peut m'aider à coriger mon erreur...
Voici mon code
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
|
' VB Script Document
'option explicit
' Appel code maître
MainCode
' -----------------------------------------------------------------------------
' Code Maître
' -----------------------------------------------------------------------------'
Sub MainCode()
Set ObjFSO = CreateObject("Scripting.FileSystemObject")
Parm1 = Wscript.Arguments.item(0) 'liste.txt'
Parm2 = Wscript.Arguments.item(1) 'y:\arbo'
if right(Parm2,1) = "\" then Parm2 = mid(Parm2,1,len(Parm2)-1)
If ObjFSO.FileExists(Parm1) Then
wscript.echo "la liste de base de données existe"
else
Set MonFic = ObjFSO.CreateTextFile("Y:\toto.txt")
MonFic.writeline "ça marche pas !!"""
WScript.quit
End If
Set objFile = ObjFSO.OpenTextFile(Parm1)
Do until objFile.AtEndOfStream
CheminFichier = objFile.ReadLine
result = Find(CheminFichier, "doc")
if len(result) = 0 then wscript.quit
Tbl = split(result,chr(10))
for i = 0 to Ubound(Tbl)
DeplaceFichier Tbl(i), Parm2
next
Loop
End Sub
' -----------------------------------------------------------------------------
' Fonction Deplacement de fichier
' -----------------------------------------------------------------------------
Function DeplaceFichier (CheminFichier, Source)
Dim MyPath
NbrDocFile = 0
Arbo = Source
Set ObjFSO = CreateObject("Scripting.FileSystemObject")
Set MyPath = ObjFSO.GetFolder(CheminFichier)
For each File in MyPath.Files
if ObjFSO.GetExtensionName(File) = "doc" then NbrDocFile = NbrDocFile + 1
next
If (NbrDocFile > 0) Then
If right(CheminFichier,1) = "\" Then Chemin = CheminFichier & "*.doc" else Chemin = CheminFichier & "\*.doc"
Tbl = split(Chemin,"\")
For i = 1 to Ubound(Tbl) - 1
Arbo = Arbo & "\" & Tbl(i)
msgbox (arbo)
If Not ObjFSO.FolderExists(Arbo) Then ObjFSO.CreateFolder Arbo
next
ObjFSO.CopyFile Chemin, Arbo
If not err.number = 0 then msgbox err.number & ":" & err.description else msgbox "super méga trop bien !"
If (Path.SubFolders.Count > 0) Then
For Each Folder In Path.SubFolders
Call DeplaceFichier(Folder)
Next
End If
End If
End Function
' -----------------------------------------------------------------------------
' Fonction Find
' -----------------------------------------------------------------------------
Function Find (strPath, strFileName)
Dim MyDir, MyFile, MySubDir
Dim strResult
If strFileName = Empty Then Exit Function
Set ObjFSO = CreateObject("Scripting.FileSystemObject")
Set MyDir = ObjFSO.GetFolder(strPath)
For Each MyFile In MyDir.Files
if ObjFSO.GetExtensionName(MyFile) = strFileName then strResult = strResult & strPath & vbCrLf
Next
For Each MySubDir In MyDir.SubFolders
strResult = strResult & Find(strPath & "\" & MySubDir.Name, strFileName)
Next
Find = strResult
End Function |
