Soyez le premier à donner votre avis sur cette source.
Snippet vu 16 480 fois - Téléchargée 20 fois
' ' 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
Peux-tu me donner un peut plus d'info
Je suis allé sur le site indiqué c'est à dire http://aidetse.free.fr/forum/viewtopic.php?pid=557 et j'ai télécharger le script final mais lorsque je le lance il me met l'erreur suivante
Script: C:\Documents and settings\dbelmokh\Desktop\premier.vbs
Erreur: Le fichier spécifié est introuvable.
Code: 80070002
Source: WshShell.Exec
J'ai chercher sur des forums comment résoudre l'erreur mais j'ai pas réussi a résoudre cette erreur.
Merci d'avance et bonne journée.
@+
ce lien devrait répondre à votre question:
http://aidetse.free.fr/forum/viewtopic.php?pid=557
Si non, n'hésiter pas à poser une question (avec précisions OS ...) sur ce forum [thème: vb.net ou vb6 + vbscript].
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.