VBScript - Renommage automatique des liens Favoris Réseaux

VBScript - Renommage automatique des liens Favoris Réseaux - VB/VBA/VBS - Programmation

Marsh Posté le 18-10-2005 à 11:42:57    

Bonjour a tous,
 
Comme le précise le titre de mon message, je souhaite changer de façon automatique les liens des favoris réseaux.
En effet, nous avons changés le nom du serveur de fichier (Ici Serveur1 -> Serveur2) et je souhaiterai faire un script en VBS qui changerai tous les liens vers celui ci.
 
Jusqu'à présent, j'ai juste réussi a traiter les fichiers .LNK et a les faire pointer sur mon nouveau serveur.
 
Voici le script déja employé:
 
 
****************************************************************************
Dim Silent, CurTime
Dim newlink, oldlink, oldfull, fullname, oldfile
Dim w, ws
 
const ForReading = 1
const ForWriting = 2
const ForAppending = 8
 
On Error Resume Next
 
'Find current time that the script runs
set wso = CreateObject("Wscript.Shell" )
set fso = CreateObject("Scripting.FileSystemObject" )
 
'pull the system's process variables (we'll be using TEMP
' for the output file and WINDIR for default location of  
' user's desktop folder - whether 9x or NT/2k/XP)
Set WshSysEnv = wso.Environment("PROCESS" )
 
'pull the system's profile environment variable
userprofile = wso.ExpandEnvironmentStrings("%userprofile%" )
 
'set your variables here
'silent = 0/1/2
'    0 - verbose
'    1 - turns off verification prompts
'    2 - turns off verification and initial config prompts
'curserver = server string you wish to replace
'newserver = server string you wish to change curserver to
' above server vars are needed only for when silent = 2
'ouputfile = location of output filename, you can use a string in
' place of all the code after the equal sign (i.e.  
' outputfile = "x:\temp," etc.)
'curtime = finds time of execution of script
 
Silent = 1
OSType = WshSysEnv("OS" )
CurServer = "oldsrvrname"
NewServer = "newsrvrname"
OutputFile = WshSysEnv("TEMP" ) & "\" & "migrate_shortcuts_log.htm"
CurTime = Now
WinDirectory = WshSysEnv("WINDIR" )
 
If OSType <> "Windows_NT" Then
    CheckFolder = Windirectory & "\desktop"
Else
    CheckFolder = userprofile & "\desktop"
End If
 
 
'check to see if ouputfile exists or not, deletes it if it does
If CheckFileExists(OutputFile) Then
    Set oldfile = fso.GetFile(OutputFile)
    oldfile.Delete
Else
    'wscript.echo oldfile & " does not yet exist."
End If
 
If Silent <= 1 Then
    Call CServer
End If
 
'Bring up inputbox for old server string
Sub CServer
'CurServer = InputBox ("Type the name of the server that you wish to"_
'& " replace in your shortcuts (LNK Files).","Enter old server name.",CurServer)
CurServer = "Serveur1"
    If CurServer = "" Then
        wscript.quit
    Else
        Call NServer
    End If
 
End Sub
 
 
'Bring up inputbox for new server string
Sub NServer
'NewServer = InputBox ("Enter the name of the server you would like to"_
'& " replace instances of " & CurServer & " with.","Enter new server"_
'& "name.",NewServer)
NewServer = "Serveur2"
    If NewServer = "" Then  
        Call CServer
    Else  
        Call CFolder
    End If
End Sub
 
'Bring up inputbox for root folder to search (recursive)
Sub CFolder
'CheckFolder = InputBox ("Type the root folder path that you wish to"_
'& "start your scan from (recursive).","Begin shortcut (lnk) scan"_
'& "from:",CheckFolder)
CheckFolder = userprofile
'WScript.Echo CheckFolder
        If CheckFolder = "" Then
        Call NServer
 
    End If
End Sub
 
'set fso = Nothing
'set wso = Nothing
 
'Start writing the HTM Log file...
Set w = fso.OpenTextFile (OutputFile, ForAppending, True)
    w.Writeline ("<html>" )
    w.Writeline ("<title>Changing Shortcuts in root folder "_
     & CheckFolder & "</title>" )
    w.Writeline ("<table BORDER=0 width=100% cellspacing=0 cellpadding=3>" )
    w.Writeline ("<tr>" )
    w.Writeline ("<th bgcolor=#000080 colspan=3 width=100>" )
    w.Writeline ("<p align=left>" )
    w.Writeline ("</th>" )
    w.Writeline ("</tr>" )
    w.Writeline ("<h0><B><font face=Arial color=#000033 size=2>"_
    & "Raccourcis trouvés dans: <font color=#CC0000> "_
    & CheckFolder & " <font face=Arial color=#000033 size=2>,"_
    & "Recherche périodiquement à " & CurTime & "</B></font></h0>" )
    w.WriteLine ("<TR bgcolor=gray colspan=3 width=100>" )
    w.WriteLine ("<TD><font face=Arial size=1 color=white> Chemin du raccourci"_
    & "</font></TD>" )        
    w.WriteLine ("<TD><font face=Arial size=1 color=white> Chemin Cible"_
    & "</font></TD>" )
    w.WriteLine ("<TD><font face=Arial size=1 color=white> Changé en"_
    & "</font></TD>" )
    w.WriteLine ("</TR>" )
 
If CurServer = "" Then
    wscript.echo "Vous n'avez pas spécifié de Serveur à changer!"
    Call Cserver
ElseIf NewServer = "" Then  
    wscript.echo "Vous n'avez pas spécifié de nouveau nom de serveur"_
    & " remplace" & curserver & " Par"
    Call Nserver
ElseIf CheckFolder = "" Then
   : wscript.echo "Vous evez spécifier un nom de serveur pour"_
    & " débuter le changement."
    Call CFolder
End If
 
'Recherche des raccourcis
ModifyLinks CheckFolder
 
Sub ModifyLinks (foldername):
CurServer = LCase(CurServer)
 
dim file 'for stepping through the files collection '
dim folder 'for stepping through the subfolders collection '
dim fullname 'fully qualified link file name '
dim link 'object connected to the link file '
 
'Changer tous les fichiers du dossier
For each file in fso.GetFolder(foldername).Files
 
'Vérifier seulement les fichiers lnk
If strcomp(right(file.name,4),".lnk",vbTexctCompare) = 0 then
 
'Trouver le chamin complet des raccourcis
fullname = fso.GetAbsolutePathName(file)
oldfull = fullname
 
'trouver le chemin complet de la cible dans le raccourci
set link = wso.CreateShortcut(fullname)
'targetpath = link.targetpath
targetpath = LCase(link.targetpath)
oldlink = link
     newlink = "Pas changé"
     
    'Displays current shortcut that is being checked (good for
    ' troubleshooting the script).
    'If Silent = 0 Then  
        'MsgBox "Checking shortcut: " & fullname & "." & VBCrlf_
        '& "Shortcut target: " & targetpath
    'End If
         
    'Figures the starting position of the server name
    'MyPos should = 3 if it finds curserver in shortcut  
    ' leading slashes would populate positions 1 & 2
    MyPos = InStr(1, targetpath, CurServer)
 
'If the current server (one you want to change) is found in the
' target path, then run the following code
If InStr(1, targetpath, CurServer) > 0 Then  
     
    If link.workingdirectory = "" Then
        link.workingdirectory = "not set"
    End If
     
    'En cas d'exécution en mode Affiché, Vous Afficherez chaque raccourci et son Dossier de travail
     If Silent = 0 Then
        MsgBox "Le chemin contient" & CurServer & ". Le chemin complet est: "_
        & targetpath & "." & " Le chemin de la cible est: "_
        & link.workingdirectory & "."
    End If
     
    'Sélectionner la longueur du nom du serveur d'origine
    VarLengthSrv = Len(CurServer)
     
    'Add 2 to VarLengthSrv to account for leading backslashes
    VarLengthSrv = VarLengthSrv + 2
     
    'Sélectionner la longueur du nom du serveur final
    VarLengthPath = Len(targetpath)
     
    'Subtract length of \\servername from full path to parse rest  
    ' of path to PathwoServer
    PathwoServer = VarLengthPath - VarLengthSrv
     
    'Sometimes shortcuts don't have working dirs (not sure why)
    'If there is a working dir, then run following code
    If link.workingdirectory <> "Not Set" then  
         
        'Set numerical length of working directory
        VarLengthWorking = Len(link.workingdirectory)
     
        'Subtract server length from total working dir length to
        'parse rest of path to WorkingPathwoServer
        WorkingDir = VarLengthWorking - VarLengthSrv
    Else
        link.workingdirectory = ""
    End If
     
    'Parse the actual text of PathwoServer by using the numerical  
    ' length of the path without the \\servername; do the same  
    ' for WorkingPathwoServer
    PathwoServer = Right(targetpath,PathwoServer)
    WorkingPathwoServer = Right(link.workingdirectory,WorkingDir)
     
    'wscript.echo "Path of shortcut is " & PathwoServer_
    '& ". Working folder is " & WorkingPathwoServer & "."
     
    'Display input box to modify each shortcut as the script finds them
    If Silent = 0 Then
        ModifyPath = InputBox ("Modify path for " & targetpath & ""_
        & "and replace with \\" & NewServer & PathwoServer & "?",""_
        & "Type 'yes' to modify." )
    ElseIf Silent >= 1 Then  
        ModifyPath = "yes"
    End If    
        If ModifyPath = "yes" Then
            'wscript.echo "Now setting path to \\"_
            ' & NewServer & PathwoServer
         
            oldlink = targetpath
            'Set link target path attribute to  
            ' \\newservername\targetpath
            link.targetpath = "\\" & NewServer & PathwoServer
            newlink = link.targetpath
         oldfull = link
 
         'wscript.echo newlink
         
            If VarLengthWorking <> "" Then
                'Set link working dir attribute to  
                ' \\newservername\workingpath
                link.workingdirectory = "\\" & NewServer & ""_
                & WorkingPathwoServer
            End If
 
        'Save the shortcut with the new information
        link.save
         
        'If answer above is anything but yes, the script will proceed  
        ' to the next shortcut
         
        Else
            oldfull = "Pas de changement"
        End if
     
    'Clear link variable
 
End if
 
'write output to logfile
Call WriteEntry  
End If
 
Next
 
'process all the subfolders in the folder
For each folder in fso.GetFolder(foldername).Subfolders
call ModifyLinks(folder.path)
 
Next
End Sub
 
 
'********************************************************************
'********************************************************************
'Recherche des raccourcis default user
 
CheckFolder = "C:\Documents and Settings\Default User"
ModifyLinks CheckFolder
 
Sub ModifyLinks (foldername):
CurServer = LCase(CurServer)
 
dim file 'for stepping through the files collection '
dim folder 'for stepping through the subfolders collection '
dim fullname 'fully qualified link file name '
dim link 'object connected to the link file '
 
'Changer tous les fichiers du dossier
For each file in fso.GetFolder(foldername).Files
 
'Vérifier seulement les fichiers lnk
If strcomp(right(file.name,4),".lnk",vbTexctCompare) = 0 then
 
'Trouver le chamin complet des raccourcis
fullname = fso.GetAbsolutePathName(file)
oldfull = fullname
 
'trouver le chemin complet de la cible dans le raccourci
set link = wso.CreateShortcut(fullname)
'targetpath = link.targetpath
targetpath = LCase(link.targetpath)
oldlink = link
     newlink = "Pas changé"
     
    'Displays current shortcut that is being checked (good for
    ' troubleshooting the script).
    'If Silent = 0 Then  
        'MsgBox "Checking shortcut: " & fullname & "." & VBCrlf_
        '& "Shortcut target: " & targetpath
    'End If
         
    'Figures the starting position of the server name
    'MyPos should = 3 if it finds curserver in shortcut  
    ' leading slashes would populate positions 1 & 2
    MyPos = InStr(1, targetpath, CurServer)
 
'If the current server (one you want to change) is found in the
' target path, then run the following code
If InStr(1, targetpath, CurServer) > 0 Then  
     
    If link.workingdirectory = "" Then
        link.workingdirectory = "not set"
    End If
     
    'En cas d'exécution en mode Affiché, Vous Afficherez chaque raccourci et son Dossier de travail
     If Silent = 0 Then
        MsgBox "Le chemin contient" & CurServer & ". Le chemin complet est: "_
        & targetpath & "." & " Le chemin de la cible est: "_
        & link.workingdirectory & "."
    End If
     
    'Sélectionner la longueur du nom du serveur d'origine
    VarLengthSrv = Len(CurServer)
     
    'Add 2 to VarLengthSrv to account for leading backslashes
    VarLengthSrv = VarLengthSrv + 2
     
    'Sélectionner la longueur du nom du serveur final
    VarLengthPath = Len(targetpath)
     
    'Subtract length of \\servername from full path to parse rest  
    ' of path to PathwoServer
    PathwoServer = VarLengthPath - VarLengthSrv
     
    'Sometimes shortcuts don't have working dirs (not sure why)
    'If there is a working dir, then run following code
    If link.workingdirectory <> "Not Set" then  
         
        'Set numerical length of working directory
        VarLengthWorking = Len(link.workingdirectory)
     
        'Subtract server length from total working dir length to
        'parse rest of path to WorkingPathwoServer
        WorkingDir = VarLengthWorking - VarLengthSrv
    Else
        link.workingdirectory = ""
    End If
     
    'Parse the actual text of PathwoServer by using the numerical  
    ' length of the path without the \\servername; do the same  
    ' for WorkingPathwoServer
    PathwoServer = Right(targetpath,PathwoServer)
    WorkingPathwoServer = Right(link.workingdirectory,WorkingDir)
     
    'wscript.echo "Path of shortcut is " & PathwoServer_
    '& ". Working folder is " & WorkingPathwoServer & "."
     
    'Display input box to modify each shortcut as the script finds them
    If Silent = 0 Then
        ModifyPath = InputBox ("Modify path for " & targetpath & ""_
        & "and replace with \\" & NewServer & PathwoServer & "?",""_
        & "Type 'yes' to modify." )
    ElseIf Silent >= 1 Then  
        ModifyPath = "yes"
    End If    
        If ModifyPath = "yes" Then
            'wscript.echo "Now setting path to \\"_
            ' & NewServer & PathwoServer
         
            oldlink = targetpath
            'Set link target path attribute to  
            ' \\newservername\targetpath
            link.targetpath = "\\" & NewServer & PathwoServer
            newlink = link.targetpath
         oldfull = link
 
         'wscript.echo newlink
         
            If VarLengthWorking <> "" Then
                'Set link working dir attribute to  
                ' \\newservername\workingpath
                link.workingdirectory = "\\" & NewServer & ""_
                & WorkingPathwoServer
            End If
 
        'Save the shortcut with the new information
        link.save
         
        'If answer above is anything but yes, the script will proceed  
        ' to the next shortcut
         
        Else
            oldfull = "Pas de changement"
        End if
     
    'Clear link variable
 
End if
 
'write output to logfile
Call WriteEntry  
End If
 
Next
 
'process all the subfolders in the folder
For each folder in fso.GetFolder(foldername).Subfolders
call ModifyLinks(folder.path)
 
Next
End Sub
 
'********************************************************************
'********************************************************************
 
 
'--------------------
' Function WriteEntry pour écrire les changement dans le fichier LOG  
'--------------------
 
Function WriteEntry
If newlink <> "0" Then
    w.WriteLine ("<TR>" )
    w.WriteLine ("<TD><font face=Arial color=#000033 size=1>" & ""_
    & oldfull & "</font></TD>" )        
    w.WriteLine ("<TD><font face=Arial color=#000033 size=1>" & ""_
    & oldlink & "</font></TD>" )
    w.WriteLine ("<TD><font face=Arial color=#000033 size=1>" & ""_
    & newlink & "</font></TD>" )
    w.WriteLine ("</TR>" )
oldfull = "0"
newlink = "0"
oldlink = "0"
 
End If
End Function
 
'-------------------
'Fonction pour voir si le fichier de sortie existe
'-------------------
 
Function CheckFileExists(sFileName)
 
Dim FileSystemObject
Set FileSystemObject = CreateObject("Scripting.FileSystemObject" )
If (FileSystemObject.FileExists(sFileName)) Then
    CheckFileExists = True
Else
    CheckFileExists = False
End If
Set FileSystemObject = Nothing
End Function
 
w.Writeline ("</html>" )
 
'if silent = 2, then it will not open the log file
If Silent <= 1 Then
    'set command variable with path in quotes (for long filenames)
    Command = Chr(34) & OutputFile & Chr(34)
     
    'run htm file in your default browser
    wso.Run Command
End If  
 
WScript.Echo "    Done "
 
 
***********************************************************************
 
Peut être que la sollution est de connaitre l'extension des liens des Favoris réseaux et de procéder de la même façon.
 
Il ne resterai plus que les mappages réseaux a modifier, mais la je n'ai aucune idée de comment procéder.
 
Pouvez vous m'aider ou m'aiguiller car je tourne un peu en rond.
 
A+
Vince

Reply

Marsh Posté le 18-10-2005 à 11:42:57   

Reply

Sujets relatifs:

Leave a Replay

Make sure you enter the(*)required information where indicate.HTML code is not allowed