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 |
Partager