Category Archives: VBScript & WSH

Copie des fichiers modifiés depuis h heures vers un autre répertoire

' copie des fichiers modifiés depuis h heures vers un autre répertoire
' d'autres programmes doivent pouvoir faire ca aussi bien, voir mieux, mais c'est pas grave.
Option Explicit
Dim RepSource, RepDest, Duree
Dim objFSO, objFolder, colFiles, objFile
Dim Subfolder, Fic, Liste, FicListe, intReturn, WshShell
' **************************************************************
' * Configuration
' **************************************************************
' répertoire à inspecter
RepSource="c:Sauvegarde"
' répertoire de destination des fichiers à copier
RepDest="c:temp"
' duree en h de prise en compte des fichiers modifies
Duree=24
' **************************************************************
' *Fin  Configuration
' **************************************************************
' traitement du répertoire principal
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(RepSource)
Set colFiles = objFolder.Files
For Each objFile in colFiles
TraiteFichier objFile
Next
' traitement des sous-répertoires
AnalyseRep objFSO.GetFolder(RepSource)
Sub AnalyseRep(Folder)
For Each Subfolder in Folder.SubFolders
'Wscript.Echo Subfolder.Path
Set objFolder = objFSO.GetFolder(Subfolder.Path)
Set colFiles = objFolder.Files
For Each objFile in colFiles
TraiteFichier objFile
Next
AnalyseRep Subfolder
Next
End Sub
' routine de traitement des fichiers
Sub TraiteFichier(Fichier)
Set Fic = objFSO.GetFile(Fichier)
if DateDiff ("h", Fic.DateLastModified, Now) < Duree Then
Liste = Liste & vbNewLine & Fic.path
end if
End Sub
' Message de confirmation de la copie
intReturn = MsgBox ("Etes-vous sûr de vouloir copier les fichiers suivants vers " & RepDest & " :" _
& vbNewLine & liste, VBOKCancel, "Sauvegarde des fichiers modifies depuis " & Duree & "heures")
Set WshShell = WScript.CreateObject("WScript.Shell")
' Copie des fichiers
FicListe = Split(liste, vbNewline)
if intReturn = VBOK then
for each Fic in FicListe
if Fic <> "" Then
If objFSO.FileExists(RepDest & "" & objFSO.GetFileName(Fic)) Then
WScript.Echo "Le fichier " & RepDest & "" & objFSO.GetFileName(Fic) & " existe déjà. Copie du fichier annulée."
else
objFSO.CopyFile objFSO.GetAbsolutePathName(Fic), RepDest & ""
end if
end if
Next
WshShell.Popup "Sauvegarde terminée."
else
WshShell.Popup "Sauvegarde annulée."
end if

Changement du répertoire de base d’utilisateurs dans la base Active Directory

' Set SetInfo.vbs
' VBScript to Set Descriptions and Departments in a named OU
' Author Guy Thomas http://computerperformance.co.uk/
' Version 2.3 - September 27th 2004
' Adapted by Luc Santeramo - April 2006
' Now
' Version 4 -
' -----------------------------------------------------------------'
Option Explicit
Dim obj, objOU, objUser, objRootDSE, intCounter
Dim strContainer, strDNSDomain, strMyOU
Dim homeDir
strMyOU="OU=CI"
' Connection à AD
Set objRootDSE = GetObject("LDAP://RootDSE")
strDNSDomain = objRootDSE.Get("DefaultNamingContext")
'Recuperation des données AD du domaine
set objOU = GetObject("LDAP://" & strDNSDomain )
intCounter = 0
For each obj in objOU
' on ne traite que les objets de type "OU"
if obj.class="organizationalUnit" Then
' on ne traite que l'OU choisie
if obj.name=strMyOU Then
Wscript.Echo obj.name
Set objOU = GetObject("LDAP://OU=Users," & obj.name & "," & strDNSDomain )
' pour chaque objet de l'OU on effectue le traitement
For each objUser in objOU
' traitement
homeDir = Split(objUser.homeDirectory, "")
if UBound(homeDir) > 0 Then
' changement du repertoire de base de l'utilisateur
objUser.Put "homeDirectory", "\seac-pdcusers%username%"
objUser.SetInfo
Wscript.Echo objUser.sAMAccountName
end if
' fin traitement
intCounter = intCounter + 1
next
End if
End if
next
Wscript.Echo intCounter
WScript.Quit