Dim WSHShell Dim vUserName, varNewName, varResultat Dim objFSO, objTextFile Dim NomFichier, CheminFichier, CheminScriptActuel, ScriptFileName, Position 'Déclaration des constantes Const ForReading = 1 Const ForWritting = 2 Const ForAppending = 8 Const CstLogger = 1 Set WSHShell = CreateObject("WScript.Shell") vUserName = WSHShell.ExpandEnvironmentStrings("%USERNAME%") 'Pour le login du user ScriptFileName = wscript.scriptname Position = InstrRev(ScriptFileName,".") if (Position > 0) Then ScriptFileName = Left(ScriptFileName, Position - 1) NomFichier = ScriptFileName & "_" & vUserName & "_Log.txt" CheminScriptActuel = Left(wscript.scriptfullname,Len(wscript.scriptfullname)-Len(wscript.scriptname)-1) CheminFichier = CheminScriptActuel & "\" & NomFichier 'Déclaration du chemin et du nom du fichier If CstLogger = 1 Then Set objFSO = CreateObject("Scripting.FileSystemObject") Set objTextFile = objFSO.OpenTextFile(CheminFichier, ForWritting, True) objTextFile.WriteLine(Now) 'On ecrit la date et l'heure dans le fichier End If 'Wscript.Echo "vUserName : " & vUserName strComputer = "." WScript.Sleep(8000) If CstLogger = 1 Then objTextFile.WriteLine(Now & "Debut du premier passage") Call subRenamePrinters If CstLogger = 1 Then objTextFile.WriteLine(Now & "Fin du premier passage") WScript.Sleep(20000) If CstLogger = 1 Then objTextFile.WriteLine(Now & "Debut du second passage") Call subRenamePrinters If CstLogger = 1 Then objTextFile.WriteLine(Now & "Fin du second passage") WScript.Sleep(60000) If CstLogger = 1 Then objTextFile.WriteLine(Now & "Debut du troisieme passage") Call subRenamePrinters If CstLogger = 1 Then objTextFile.WriteLine(Now & "Fin du troisieme passage") Sub subRenamePrinters() Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\CIMV2") Set colItems = objWMIService.ExecQuery("SELECT * FROM Win32_Printer",,48) For Each objItem in colItems 'Wscript.Echo "-----------------------------------" 'Wscript.Echo "Win32_Printer instance" 'Wscript.Echo "-----------------------------------" varName = objItem.Name 'Wscript.Echo "Name: " & varName If CstLogger = 1 Then objTextFile.WriteLine(varName) 'Nom de l'imprimante regardée 'FindPrinterAndDelete 'Determination du nom cible MyPos = InStr (Lcase(varName), "(") If MyPos > 0 Then 'Si la file d'impression contient une ( varNewName = Left(varName, MyPos-1) varNewName = Trim(varNewName) & "_" & vUserName If Lcase(varName) <> Lcase(varNewName) Then 'Si la file d'impression doit être renommée 'Wscript.Echo "Renomage en " & varNewName If CstLogger = 1 Then objTextFile.WriteLine("La file d'impression doit être renommée en " & varNewName) 'Nom de l'imprimante regardée If CstLogger = 1 Then objTextFile.WriteLine("Effacement eventuel d une precedente file : ") 'Nom de l'imprimante regardée varResultat = FindPrinterAndDelete(varNewName) If (CstLogger = 1) And (varResultat = 0) Then objTextFile.WriteLine("Pas d effacement d une precedente file nommee " & varNewName) 'Nom de l'imprimante regardée If (CstLogger = 1) And (varResultat = 1) Then objTextFile.WriteLine("Une precedente file d impression nommee " & varNewName & " a ete effacee") 'Nom de l'imprimante regardée If CstLogger = 1 Then objTextFile.WriteLine("Renommage de " & varName & " en " & varNewName) intResult = objItem.RenamePrinter(varNewName) Select case intResult 'Case 0 : WScript.Echo "Success" 'Case 5 : WScript.Echo "Access denied" 'Case 1801 : WScript.Echo "Invalid printer name" End Select 'exit for End If End If Next Set colItems = Nothing Set objWMIService = Nothing End Sub Function FindPrinterAndDelete(ByVal varNomPrinter) Dim varTrouve Dim objWMIServiceforDelete, colItemsforDelete varTrouve = 0 Set objWMIServiceforDelete = GetObject("winmgmts:\\" & strComputer & "\root\CIMV2") Set colItemsforDelete = objWMIServiceforDelete.ExecQuery("SELECT * FROM Win32_Printer where Name = '" & varNomPrinter & "'",,48) For Each objItem in colItemsforDelete varTrouve = 1 objItem.Delete_ 'Effacement de la file d'impression Exit For Next FindPrinter = varTrouve End Function Set WSHShell = Nothing If CstLogger = 1 Then objTextFile.Close 'Fermeture du fichier Set objTextFile = Nothing Set objFSO = Nothing End If