Prob CopyFile avec varaiable

Version imprimable

Bonjour à tous,

j'ai problème avec cette ligne :

Code:

1
2
3
4
 
FolderDest = "C:\LNKs\lnk 001\"
'objFSO.CopyFile RunAsAdmin, Destination, OverWriteExisting
objFSO.CopyFile RunAsAdmin, FolderDest & LNKNameFile & ".VBS"

si j'utilise la variable FolderDest, les fichiers sont copiés correctement!
par contre, si je remplace FolderDest par la variable Destination provenant des SUB, cela ne fonctionne pas!
Pourtant WScript.echo affiche le chemin complet avec le nom de fichier!

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
 
Const ForReading = 1
Const ForWriting = 2
Const ForAppending = 8
 
 
'strStartFolder = "C:\ProgramData\Microsoft\Windows\Start Menu\Programs"
strStartFolder = "C:\TMP"
RunAsAdmin = "C:\LNKs\RunAsAdmin.vbs"
FolderDest = "C:\LNKs\lnk 001\"
 
Set objFSO = CreateObject("Scripting.FileSystemObject")
 
'Creation d'un nouveau fichier vierge
outChemin="C:\LNKs\Chemin_LNK.txt"
Set objFile = objFSO.CreateTextFile(outChemin,True)
objFile.Close
 
'Creation d'un nouveau fichier vierge
outNonFichier="C:\LNKs\NonFichier_LNK.txt"
Set objFile = objFSO.CreateTextFile(outNonFichier,True)
objFile.Close
 
' Si sous-dossier existe alors communique la variable à la fonction ShowSubFolders
If objFSO.FolderExists(strStartFolder) Then
	ShowSubFolders objFSO.GetFolder(strStartFolder)			
End If
 
' Liste tout fichier LNK contenu dans l'arborescence du dossier racine
Sub ShowSubFolders(objFolder)
	For Each objFile In  objFolder.Files
		' Enumère tous les fichiers ShortCut LNK
		If InStr(1, ".lnk", Lcase(Right(objFile.Name,4))) <> 0 Then
			' Chemin complet du raccourci
			LNKPath = objFolder.Path & "\"
			LNKFull = objFolder.Path & "\" & objFile.Name
			'Wscript.Echo "Chemin complet : " & LNKFull
 
			LNKName = objfile.name
			'Wscript.Echo "Nom du Raccourci : " & objfile.name
			'Wscript.Echo "LNKName : " & LNKName
 
			AppendChemin(LNKFull)
			AppendNom LNKPath, LNKName
		End If
	Next
    For Each objSubfolder In objFolder.SubFolders
        ShowSubFolders objSubfolder
    Next
End Sub
 
Sub AppendChemin(strLNKFull)
			' Ajout des Chemins LNK dans un fichier 
			Set objFile = objFSO.OpenTextFile(outChemin, ForAppending)
			objFile.write strLNKFull & vbCrLf
			objFile.Close
End Sub
 
Sub AppendNom(strLNKPath, strLNKName)
			'Wscript.Echo "strLNKName --> Nom avec Extension : " & vbCrLf & vbCrLf & strLNKName
 
			'Suppression de l'extension .LNK
			Set obj = CreateObject("vbscript.regexp")
			obj.Global = True
			'obj.Pattern = "[.\s]|lnk"  ' Supprimer .LNK et tous les caractères espace trouvés 
			obj.Pattern = "[.]|lnk"
			strLNKName = obj.Replace(strLNKName, "")
			'Wscript.Echo "strLNKName --> Nom sans Extension : " & vbCrLf & vbCrLf & strLNKName
 
			' Ajout des Noms LNK dans un fichier 
			Set objFile = objFSO.OpenTextFile(outNonFichier, ForAppending)
			objFile.write strLNKName & vbCrLf
			'objFile.write mTab & vbCrLf
 
			'Destination = strLNKPath & strLNKName & ".VBS"
			'Wscript.Echo "Destination : --> " & vbCrLf & vbCrLf & Destination
			'objFSO.CopyFile RunAsAdmin, Destination
 
 
			CreateRename strLNKPath, strLNKName
			objFile.Close
End Sub
 
Sub CreateRename(LNKNamePath, LNKNameFile)
			Destination = LNKNamePath & LNKNameFile & ".VBS"
			'Wscript.Echo "Destination : --> " & vbCrLf & vbCrLf & Destination
 
 
 
			'objFSO.CopyFile RunAsAdmin, Destination
			objFSO.CopyFile RunAsAdmin, FolderDest & LNKNameFile & ".VBS"
 
 
End Sub

la variable Destination contient des valeurs différentes!
Aurai-je oublié quelque chose?

Merci de votre aide

09/08/2014, 01h08
l_autodidacte

Citation:

Aurai-je oublié quelque chose?

Oh que si, c'est de regarder dans C:\TMP et ses sous-dossiers
Ta variable LNKNamePath (ligne 84) pointe vers le dossier source et pas le dossier cible !!!!!!!!!!

Il faut donc en tenir compte lors de l'appel de CreateRename

Merci pour ta réponse!

en fait l'erreur venait d'ici : strStartFolder = "C:\TMP"

j'ai repris le code et suis à la fin!

j'ai un problème pour exécuter les fichiers RunAsAdmin.vbs situé dans les sous-dossiers

la commande se trouve dans Sub ExecRunAsAdmin(strRacine)

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
 
Sub ExecRunAsAdmin(strRacine)
WScript.Echo "strRacine : " & strRacine
		For Each objFile In  strRacine.Files
		' Enumère tous les fichiers RunAsAdmin.vbs
		If InStr(1, "RunAsAdmin.vbs", Lcase(Right(objFile.Name,8))) <> 0 Then
			' Chemin Uniquement
			LNKPath = strRacine.Path & "\"
			' Chemin Complet avec Nom Fichier LNK
			LNKFull = strRacine.Path & "\" & objFile.Name
			WScript.Echo "Chemin complet : " & LNKFull
 
			ListeVBS(LNKFull)
			'CreateObject("WScript.Shell").Run LNKFull
			Set WshShell = CreateObject("WScript.Shell")
			WshShell.Run strRacine.Path & "\" & "RunAsAdmin.vbs", 0, True
			'WshShell.Run LNKFull, 0, True
		End If
	Next
    For Each objSubfolder In strRacine.SubFolders
        ExecRunAsAdmin objSubfolder
    Next
 
End Sub

l'une ou l'autre fonctionne uniquement dans le dossier racine; pourtant le chemin est ok

voici le code complet :

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
 
' ========================================================================================================= '
'  Cette routine permet d'activer l'option avancée "Exécuter en tant qu'administrateur" de raccourcis LNK
'   Il répertorie l'arborescence d'un dossier racine cible  dans  "Chemin_LNK.txt", créer à la racine 
'   Il copie le fichier de traitement "RunAsAdmin.vbs" dans chaqu'un des sous-dossiers.
'  La nouvelle valeur du chemin du sous-dossier sera inscrite dans le fichier de traitement "RunAsAdmin.vbs"
' ========================================================================================================= '
 
Const ForReading = 1
Const ForWriting = 2
Const ForAppending = 8
 
' Dossier racine de l'arborescence
' "C:\ProgramData\Microsoft\Windows\Start Menu\Programs"
strStartFolder = "C:\LNKs"
' Chemin script pour la case "Exécuter en tant qu'administrateur"
RunAsAdmin = "C:\LNKs\RunAsAdmin\RunAsAdmin.vbs"
 
Set objFSO = CreateObject("Scripting.FileSystemObject")
 
'Creation du futur fichier contenant le chemin complet de chaque *.LNK
outListeLNK="C:\LNKs\Chemin_LNK.txt"
Set objFile = objFSO.CreateTextFile(outListeLNK,True)
objFile.Close
 
'Creation du futur fichier contenant le chemin complet de chaque *.VBS
outListeVBS="C:\LNKs\Chemin_VBS.txt"
Set objFile = objFSO.CreateTextFile(outListeVBS,True)
objFile.Close
 
' Si sous-dossier existe alors communique la variable à la fonction ShowSubFolders
If objFSO.FolderExists(strStartFolder) Then
	ShowSubFolders objFSO.GetFolder(strStartFolder)
	ExecRunAsAdmin objFSO.GetFolder(strStartFolder)	
End If
 
' Liste tout fichier LNK contenu dans l'arborescence du dossier racine
Sub ShowSubFolders(objFolder)
	For Each objFile In  objFolder.Files
		' Enumère tous les fichiers ShortCut LNK
		If InStr(1, ".lnk", Lcase(Right(objFile.Name,4))) <> 0 Then
			' Chemin Uniquement
			LNKPath = objFolder.Path & "\"
			' Chemin Complet avec Nom Fichier LNK
			LNKFull = objFolder.Path & "\" & objFile.Name
			'WScript.Echo "Chemin complet : " & LNKFull
 
			ListeLNK(LNKFull)
			CopieFichier(LNKPath)
		End If
	Next
    For Each objSubfolder In objFolder.SubFolders
        ShowSubFolders objSubfolder
    Next
 
End Sub
 
Sub ListeLNK(strLNKFull)
			' Ajout les Chemin Complet avec Nom Fichier LNK dans un fichier 
			Set objFile = objFSO.OpenTextFile(outListeLNK, ForAppending)
			objFile.write strLNKFull & vbCrLf
			objFile.Close
End Sub
 
Sub CopieFichier(strLNKPath)
			' Copy le fichier RunAsAdmin.vbs dans chaque sous-dossier et dossier racine
			objFSO.CopyFile RunAsAdmin, strLNKPath
			ActiveRunAsAdmin(strLNKPath)
			'WScript.Echo "Nouveau Chemin Cible complet : " & vbCrLf & vbCrLf & strLNKPath & "RunAsAdmin.vbs"
End Sub
 
Sub ActiveRunAsAdmin(RunAsAdminLNKPath)
' la procédure recherche un mot clef connu dans un fihier puis le remplace par une autre valeur variable -- strNewText --
' ligne effectuant l'oprération -- strNewText = Replace(strText, strOldText, strNewText) --
 
			'WScript.Echo "Nouveau Chemin Cible Uniquement  - RunAsAdminLNKPath : " & vbCrLf & vbCrLf & RunAsAdminLNKPath
			Dim oFSO, rech, Ligne
 
			strNewText = RunAsAdminLNKPath
			'WScript.Echo "Nouveau Chemin Cible Uniquement - strNewText : " & vbCrLf & vbCrLf & strNewText
 
			strFileName = RunAsAdminLNKPath & "RunAsAdmin.vbs"
			'WScript.Echo "Nouveau Chemin Cible et fichier RunAsAdmin.vbs - strfileName : " & vbCrLf & vbCrLf & strfileName
 
			strOldText = "Chemin"
			'WScript.Echo "Mot clef à trouver dans le fichier RunAsAdmin.vbs de référence - strOldText : " & vbCrLf & vbCrLf & strOldText
 
			Set objFSO = CreateObject("Scripting.FileSystemObject")
 
			' Si fichier non existant, alors stop
			If objFSO.FileExists(strFileName) = False Then Wscript.Quit
 
			Set objFile = objFSO.OpenTextFile(strFileName, ForReading)
				rech = 0
				While Not objFile.AtEndOfStream
					Ligne = objFile.ReadLine
					' Recherche la présence strOldText et combien de fois
					If Instr(Ligne, strOldText) <> 0 Then rech = rech + 1
				Wend
				'WScript.Echo "Mot clef à trouvé " & vbCrLf & vbCrLf & rech & "x" & vbCrLf & vbCrLf & "dans le fichier"
 
			objFile.Close
 
			Set objFile = objFSO.OpenTextFile(strFileName, ForReading)
			strText = objFile.ReadAll
			objFile.Close
 
			strNewText = Replace(strText, strOldText, strNewText)
			Set objFile = objFSO.OpenTextFile(strFileName, ForWriting)
			objFile.Write strNewText
			objFile.Close
End Sub
 
Sub ExecRunAsAdmin(strRacine)
WScript.Echo "strRacine : " & strRacine
		For Each objFile In  strRacine.Files
		' Enumère tous les fichiers RunAsAdmin.vbs
		If InStr(1, "RunAsAdmin.vbs", Lcase(Right(objFile.Name,8))) <> 0 Then
			' Chemin Uniquement
			LNKPath = strRacine.Path & "\"
			' Chemin Complet avec Nom Fichier LNK
			LNKFull = strRacine.Path & "\" & objFile.Name
			WScript.Echo "Chemin complet : " & LNKFull
 
			ListeVBS(LNKFull)
			'CreateObject("WScript.Shell").Run LNKFull
			Set WshShell = CreateObject("WScript.Shell")
			WshShell.Run strRacine.Path & "\" & "RunAsAdmin.vbs", 0, True
			'WshShell.Run LNKFull, 0, True
		End If
	Next
    For Each objSubfolder In strRacine.SubFolders
        ExecRunAsAdmin objSubfolder
    Next
 
End Sub
 
Sub ListeVBS(strLNKFull)
			' Ajout les Chemin Complet avec Nom Fichier VBS dans un fichier 
			Set objFile = objFSO.OpenTextFile(outListeVBS, ForAppending)
			objFile.write strLNKFull & vbCrLf
			objFile.Close
End Sub

merci d'avance pour vos lumière...

09/08/2014, 11h35
Invité

1 pièce(s) jointe(s)

Voici l'erreur

Pièce jointe 153259
09/08/2014, 15h56
Invité

J'ai trouvé la solution :

il faut les guillemtes :

WshShell.Run chr(34) & LNKFull & chr(34), 0, True

Bonne journée