1. Accueil
  2. Tous les snippets
  3. Snippets Visual Basic / VB.NET
  4. Inventaire fichiers sur server distant ou local

Inventaire fichiers sur server distant ou local

Soyez le premier à donner votre avis sur cette source.

Snippet vu 16 535 fois - Téléchargée 20 fois

Commenter

Contenu du snippet

Suite au topic "http://www.vbfrance.com/infomsg_CREATION-TABLE-MATIERES_888257.aspx#3 de mastere30, du 14/02/2007",
qui utilise des .bat pour inventorier certains fichiers sur plusieurs servers distants, et au vu de la durée
d'exécution de ces batchs, je me suis essayé à créer un script vbs paramétrable utilisant wbem et wmi.

Source / Exemple : 


'
' 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

Conclusion :


Ce script nécessite de connaitre les hostname, loggin et password du server.
Je rajouterai comment automatiser l'exécution sur plusieurs servers, mais avec
perte de confidentialité du loggin/password, en remplacant les 2 inputbox par un fichier .txt

J'ai mis un peu plus de commentaires qu'à l'accoutumée !
Il n'y a rien de bien compliqué et les objets/variables sont assez explicites.
N'hésitez à me signaler les éventuelles incompréhensions.

jean-marc

A voir également

Ajouter un commentaire Commentaires
Signaler
Messages postés
14
Date d'inscription
jeudi 2 juillet 2009
Statut
Membre
Dernière intervention
18 septembre 2009
J'aimerais effectuer le même style de code en utilisant un fichier .txt et non un inputbox comme tu le note dans la conclusion.

Peux-tu me donner un peut plus d'info
Signaler
Messages postés
8
Date d'inscription
mercredi 9 mai 2007
Statut
Membre
Dernière intervention
15 mai 2007
Merci tout d'abord pour le lien.
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.
@+
Signaler
Messages postés
1854
Date d'inscription
jeudi 23 mai 2002
Statut
Membre
Dernière intervention
24 juin 2018
 26
Bonjour,
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].
Signaler
Messages postés
8
Date d'inscription
mercredi 9 mai 2007
Statut
Membre
Dernière intervention
15 mai 2007
Je suis tres interresser par ce bout de code, je suis débutant en vbs et je voulais savoir s'il était possible de receuillir ces infos tel le user qui est loggé sur une machine sans avoir a connaitre son password ou quoi mais entrer le nom de la machine et ensuite que le programme crée un fichier au nom du pc, c'est possible ?
S'inscrire maintenant

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.

Du même auteur (cs_JMO)