Bonjour à tous!

Voici le problème :

dans C:\ProgramData\Microsoft\Windows\Start Menu\Programs, j'ai une série de raccourcis!
Lors du déclanchement, une fenêtre "d'avertissement de sécurité" apparaît :

Nom : _RunAsAdmin_1.jpg Affichages : 1718 Taille : 42,8 Ko

En fait, il s'agit de cocher l'option "Exécuter en tant qu'administrateur" pour éliminer le message!

Venant au fait!
Le but est d'automatiser l'opération de tous les raccourcis contenu dans C:\ProgramData\Microsoft\Windows\Start Menu\Programs et les sous-dossiers.

J'ai deux fichiers :
01.vbs (scanne l'arborescence à la recherche de fichier type LNK)
02.vbs (coche la case "Exécuter en tant qu'administrateur)

Le problème est le suivant :
Tous les chemins et nom de fichier avec des espaces ne fonctionne pas!

j'ai trouvé cette information suivante pour le traitement avant l'envoie en argument

http://stackoverflow.com/questions/1...sing-arguments

c'est sur ce point que je séche...

voici les deux fichiers

--> 01.vbs
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
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
 
 
'strStartFolder = "C:\ProgramData\Microsoft\Windows\Start Menu\Programs"
strStartFolder = "C:\TMP"
 
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set wshShell = CreateObject("WScript.Shell")
 
intCounter = 2
 
' Création de l'objet Feuille Excel
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True
Set objWB = objExcel.Workbooks.Add
Set objSheet = objWB.Sheets(1)
 
' configuration des colonnes Excel
objSheet.Cells(1, 1).Value = "Chemin"
objSheet.Cells(1, 2).Value = "Nom Fichier"
 
' Configuration des largeurs des colonnes Excel
objSheet.Columns(1).ColumnWidth = 150
objSheet.Columns(2).ColumnWidth = 75
objSheet.Columns(3).ColumnWidth = 30
 
' Configuration de la feuille Excel
objSheet.Range("A1:B1").Font.Bold = True
objSheet.Range("A1:B1").Interior.ColorIndex = 1 'Black
objSheet.Range("A1:B1").Interior.Pattern = 1 'xlSolid
objSheet.Range("A1:B1").Font.ColorIndex = 44 'Gold
 
objSheet.Range("A2").Select
 
' 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 contenu dans la variable "strStartFolder"
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
		Wscript.Echo "Nom du Raccourci --> objfile.name : " & objfile.name
 
			' Chemin complet du raccourci
			LNKPath = objFolder.Path & "\"
			LNKFull = objFolder.Path & "\" & objFile.Name
			'Wscript.Echo "Chemin complet : " & LNKFull
 
 
			LNKName = objfile.name
			'Wscript.Echo "LNKName : " & LNKName
 
			objSheet.Cells(intCounter, 1).Value = LNKFull
			objSheet.Cells(intCounter, 2).Value = objFile.Name
			intCounter = intCounter + 1
 
			arglist = ""
			With WScript.Arguments
				For Each arg In .Named
					arglist = arglist & " /" & arg & ":" & qq(.Named(arg))
					Wscript.Echo "arglist : " & arglist
				Next
				For Each arg In .Unnamed
					arglist = arglist & " " qq(arg)
				Next
	End With
			CreateObject("WScript.Shell").Run "02.vbs " & Trim(LNKPath) & Trim(LNKname), 0, True
 
 
		End If
	Next
 
    For Each objSubfolder In objFolder.SubFolders
        ShowSubFolders objSubfolder
    Next
End Sub
 
Sub qq(str)
  qq = Chr(34) & str & Chr(34)
End Sub
 
' L'objet WSCript.Arguments permet de connaitre les éventuels arguments passées au script lors
'de son exécution. 
 
' Les balises Named et UnNamed, dont le rôle esr d'indiquer les paramètres attendus pour un script wsf,
'sont à utiliser au sein d'une balise RunTime, elle-même placée dans une balise Job
 
' http://books.google.fr/books?id=Iy8nLi_EDWoC&pg=PT215&lpg=PT215&dq=With+WScript.Arguments&source=bl&ots=AoWRl3x7xW&sig=azZLwDmMdrrjnZB1CiTgw6MLlKk&hl=fr&sa=X&ei=QtzhU8W-JPHP4QSHg4Ao&ved=0CDsQ6AEwAw#v=onepage&q=With%20WScript.Arguments&f=false
--> 02.vbs
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
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
 
 
Option Explicit
 
Dim oArgs, ret
 
Set oArgs = WScript.Arguments
If oArgs.Count > 0  Then
    ret = fSetRunAsOnLNK(oArgs(0))
    'MsgBox "Done, return = " & ret
Else
    MsgBox "No Args"
End If
 
Function fSetRunAsOnLNK(byVal sInputLNK)
    Wscript.Echo "Argument venant de 01.VBS -- sInputLNK  --> : " & vbCrLf & vbCrLf & sInputLNK
	Dim fso, wshShell, oFile, iSize, aInput(), ts, i, ExtractFileName, ExtractFolderName, MyNumber
 
		' Récupérer uniquement le Nom fichier et son extension
		If InStr(sInputLNK, "\") = 0 Or Right(sInputLNK, 1) = "\" Then
			ExtractFileName = ""
		End If
		ExtractFileName = Mid(sInputLNK, InStrRev(sInputLNK, "\") + 1)	
		'Wscript.Echo "ExtractFileName --> Uniquement Nom Fichier LNK  : " & vbCrLf & vbCrLf & ExtractFileName
 
		' Récupérer uniquement le Chemin d'accés du fichier
		If InStr(sInputLNK, "\") = 1 Or right(sInputLNK, 1) = "\" Then
			ExtractFolderName = ""
		End If
		ExtractFolderName = Left(sInputLNK, InStrRev(sInputLNK, "\"))
		'Wscript.Echo "ExtractFolderName --> Uniquement Chemin Absolu : " & vbCrLf & vbCrLf & ExtractFolderName
 
	Set fso = CreateObject("Scripting.FileSystemObject")
    Set wshShell = CreateObject("WScript.Shell")
 
    If Not fso.FileExists(ExtractFileName) Then fSetRunAsOnLNK = 114017 : Exit Function
    Set oFile = fso.GetFile(sInputLNK)
	'Wscript.Echo "oFile : " & oFile
    iSize = oFile.Size
	'Wscript.Echo "iSize : " & iSize
    ReDim aInput(iSize)
    Set ts = oFile.OpenAsTextStream()
 
    i = 0
    Do While Not ts.AtEndOfStream
        aInput(i) = ts.Read(1)
        i = i + 1
    Loop
    ts.Close
 
    If UBound(aInput) < 50 Then fSetRunAsOnLNK = 114038 : Exit Function
	' ASC = Retourne le code de caractère ANSI correspondant à la première lettre d'une chaîne
    If (Asc(aInput(21)) And 32) = 0 Then 
        aInput(21) = Chr(Asc(aInput(21)) + 32)
		MyNumber = Asc("aInput")
		'Wscript.Echo "ASC : " & MyNumber
	Else
        fSetRunAsOnLNK = 99 : Exit Function
    End If
 
    fso.CopyFile ExtractFileName, wshShell.ExpandEnvironmentStrings(ExtractFolderName & oFile.Name & "." & Hour(Now()) & "-" & Minute(Now()) & "-" & Second(Now()))
    On Error Resume Next
    Set ts = fso.CreateTextFile(ExtractFileName, True)
    If Err.Number <> 0 Then fSetRunAsOnLNK = Err.number : Exit Function
    ts.Write(Join(aInput, ""))
    If Err.Number <> 0 Then fSetRunAsOnLNK = Err.number : Exit Function
    ts.Close
    fSetRunAsOnLNK = 0
End Function

merci d'avance de votre aide et proposition