INVENTAIRE FICHIERS SUR SERVER DISTANT OU LOCAL

'
' Inventaire de fichiers sur disks locaux
' Résultat de cet inventaire dans un fichier .xls
'
' Ce script vbs peut être lancé en local ou sur un server distant
'
'
On Error Resume Next
Const WbemAuthenticationLevelPktPrivacy = 6

Set objNetwork = CreateObject("Wscript.Network")
strLocalComputer = objNetwork.ComputerName

strCredentials = InputBox _
    ("Please enter the user name, a blank space, and then the password:", _
     "Enter User Credentials",objNetwork.UserName )     

If strCredentials = "" Then
   Wscript.Quit
End If

arrCredentials = Split(strCredentials," ")
strUser = arrCredentials(0)
strPassword = arrCredentials(1)
strNamespace = "root\cimv2"

strComputer = InputBox _
    ("Please enter the name of the computer you want to connect to:", _
        "Enter Computer Name", objNetwork.ComputerName)    

If strComputer = "" Then
   Wscript.Quit
End If

Set objWbemLocator = CreateObject("WbemScripting.SWbemLocator")
Set objWMIService = objwbemLocator.ConnectServer _
    (strComputer, strNamespace, strUser, strPassword)

objWMIService.Security_.authenticationLevel = WbemAuthenticationLevelPktPrivacy

Const ForWriting = 2
Const HARD_DISK = 3   ' 3 = Local Disk, 4 = Network Drive
Dim colDisks, colFiles, ObjTextStream, objDico
Dim objTabExt, objDisk, objFile 
Dim StartScript, i, OldList, FichierExcelServer 
StartScript=Now

FichierExcelServer = GetPath() & "inventaire_server_" & strComputer & ".xls"

'Extension des fichiers à récupérer
objTabExt = Array("xls","xlt","doc","dot","pdf","pps","ppt","htm","txt")

Set objDico = CreateObject("Scripting.Dictionary")
objDico.CompareMode = VBBinaryCompare

Set objWMIService = GetObject("winmgmts:" _
                    & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")

Set colDisks = objWMIService.ExecQuery _
	       ("Select * from Win32_LogicalDisk Where DriveType = " & HARD_DISK & "")
        
For Each objDisk in colDisks
    For i=LBound(objTabExt) To UBound(objTabExt)
        Set colFiles = objWMIService.ExecQuery _
                       ("Select * from CIM_DataFile where Drive = '" &_
                         objDisk.Name & "' And Extension = '" & objTabExt(i) &"'") 
        For Each objFile in colFiles
            If objDico.Exists(objDisk.Name & "§" & objTabExt(i)) Then

               OldList = objDico.Item(objDisk.Name & "§" & objTabExt(i))
               
               objDico.Item(objDisk.Name & "§" & objTabExt(i)) = OldList & ","  &_
                       objFile.Name & "|" & clair(objFile.LastModified)
            Else
               objDico.Add objDisk.Name & "§" & objTabExt(i), objFile.Name &_
                       "|" & clair(objFile.LastModified)
            End If
        Next
    Next
Next 
'Destruction des objets
Set colFiles =  Nothing
Set colDisks =  Nothing
Set objNetWork = Nothing
Set objWMIService = Nothing
Set objWbemLocator = Nothing

'WScript.Echo "fin read disks" &vbCrLf& Now &vbCrLf& StartScript &vbCrLf& _
'        DateDiff("n", StartTime,Now) & " minutes"

'Creation fichier xls par server
Dim cles, elements, j 
cles = objDico.Keys
elements = objDico.Items

Dim objExcel, ligne, NL, col
Set objExcel = WScript.CreateObject("Excel.Application")
objExcel.Visible = False   'oui=True   non=False
objExcel.DisplayAlerts = False
objExcel.Workbooks.Add

i = ""
For i = 0 To objDico.Count-1
    'Ajout d'une feuille 
    objExcel.ActiveWorkbook.Sheets.Add
    'Renomme la feuille
    objExcel.Sheets(1).Name = "disk=" &_
             Replace(Replace(Replace(cles(i), "§", " ext="),":",""),"\","")

    'en-tête de ligne
    objExcel.Cells(1, 1).Value = "Nom"
    objExcel.Cells(1, 2).Value = "Date de Modification"
    NL = 2
    'ecriture ligne
    ligne = Split(elements(i),",")
    For j = 0 To UBound(ligne)
        If InStr( ligne(j), "|") Then 
           col = Split(ligne(j),"|")  
           objExcel.Cells(NL, 1).Value = CStr(col(0))
           objExcel.Cells(NL, 2).Value = CStr(col(1))
           NL = NL + 1
        End If
    Next
    objExcel.Columns("A:B").Select
    objExcel.Selection.Columns.AutoFit
    ObjExcel.Range("A1").Select
Next
'Mise en forme des colonnes
objExcel.Columns("A:B").Select
objExcel.Selection.Columns.AutoFit
ObjExcel.Range("A1").Select
ObjExcel.ActiveWorkbook.SaveAs FichierExcelServer 'sauvegarde le classeur
ObjExcel.DisplayAlerts = True 'remet l'alerte  oui=True   non=False
objExcel.Application.Visible=True 'remet la visibilité
objExcel.ActiveWorkbook.Close 'Fermeture d'Excel
ObjExcel.Quit
'Destruction des objets
Set objExcel = Nothing
Set objDico = Nothing

WScript.Echo "fin du script" &vbCrLf& Now &vbCrLf& StartScript &vbCrLf& _
             "Durée: " & DateDiff("n", StartScript,Now) & " minutes"

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Mise au format jj/mm/aaaa h:m de la date
Function clair(temps)
Dim debut, an, mois, jour, h, m
	debut = left(temps,8)
	an = left(debut,4)
	mois = mid(debut,5,2)
	jour = right(debut,2)
	h = Mid(temps, 9,2)
	m = Mid(temps, 11,2)
	clair = CStr(jour) & "/" & CStr(mois) & "/" & CStr(an) & " " & h & ":" & m
End Function

'Récupère le répertoire courant
Function GetPath()
Dim path
'WScript.ScriptfullName ramène par exemple C:\MesAppli\LeScript.vbs
path = WScript.ScriptFullName
'On ne garde que ce qui est à gauche du dernier slash (compris), soit C:\MesAppli\
GetPath = Left(path, InStrRev(path, "\"))
End Function