Recherche de fichier sur disque dur. [VBS]Résolu

Question

Bonjour,

Tout d'abord je suis désolé , la question a du déjà être posé 1000 fois mais je ne trouve pas vraiment de réponse approprié à ce que je cherche.

Je suis sur que c'est tout simple mais je ne m'y connais franchement pas en VB.

Y a t'il une âme charitable pour m'aider?

J'aimerai un petit script qui au démarrage scan le disque dur afin de trouver une extansion de fichier , dans mon cas *.nsf (fichier Lotus Notes) et une fois trouver qu'il incrémente un fichier rapport se trouvant sur un chemin réseau ex: \nomdemonserveur\dossierapport.txt.
Dans ce fichier rapport devra se trouver "nom de l'ordinateur" et les fichiers .nsf trouvés sur son disque dur.

D'avance merci

cs_JMO · Accepted Answer

Bonjour à tous,

L'exemple ci-dessous, avec utilisation de WMI et de l'objet Dictionary, affiche tous les fichiers *.nsf

Option Explicit
MsgBox ShowFilesLotus,,"Result"

Private Function ShowFilesLotus()
Const HARD_DISK = 3
Dim objWMIService, colDisks, colFiles
Dim objDico, objTabExt, objDisk, objFile
Dim strComputer, i
Dim cles, strList

strComputer = "."

objTabExt = "nsf"

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
    Set colFiles = objWMIService.ExecQuery _
                   ("Select * from CIM_DataFile where Drive = '" &_
                     objDisk.Name & "' And Extension = '" & objTabExt &"'") 
    For Each objFile in colFiles
        objDico.Add objFile.Name,"" 
    Next
Next 
Set colFiles =  Nothing
Set colDisks =  Nothing
Set objWMIService = Nothing

cles = objDico.Keys
For i = 0 To objDico.Count-1
    strList = strList &vbCr& cles(i)
Next
Set objDico = Nothing
ShowFilesLotus = strList
End Function

jean-marc

mat76 · Answer

Bonjour,


J'ai repris votre script qui correspond à ce que je veux faire.
Mais il y a une subtilité que je désire et n'arrive pas à faire :( on est développeur ou on ne l'est pas...) Je voudrais que le contenu de la recherche qui s'affiche dans la texte box, s'inscrive egalement dans le fichier Lotus.txt mais sans succès.

Et le comble du bonheur pour moi serait que ces informations (dans le fichier texte) soit précédé de l'identifiant de l'ordinateur ( %computername% fichier.nsf )

     

                              Option Explicit
MsgBox ShowFilesLotus,,"Result"




Private Function ShowFilesLotus()
Const HARD_DISK = 3
Dim objWMIService, colDisks, colFiles
Dim objDico, objTabExt, objDisk, objFile
Dim strComputer, i
Dim cles, strList
Dim ObjRapport, ObjFilerapport
Const ForWriting = 2




strComputer = "."




objTabExt = "nsf"


Set ObjRapport = CreateObject("Scripting.FileSystemObject" )
Set ObjFileRapport = ObjRapport.OpenTextFile("g:\migration\Lotus\Lotus.txt",ForWriting)
ObjFileRapport.Writeline (ShowFilesLotus)
ObjFileRapport.WriteBlankLines(2)
ObjFileRapport.close




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
    Set colFiles = objWMIService.ExecQuery _
                   ("Select * from CIM_DataFile where Drive = '" &_
                     objDisk.Name & "' And Extension = '" & objTabExt &"'")
    For Each objFile in colFiles
        objDico.Add objFile.Name,""
    Next
Next
Set colFiles =  Nothing
Set colDisks =  Nothing
Set objWMIService = Nothing


cles = objDico.Keys
For i = 0 To objDico.Count-1
    strList = strList &vbCr& cles(i)
Next
Set objDico = Nothing
ShowFilesLotus = strList
End Function

cs_JMO · Answer

Bonjour,

ObjRapport.OpenTextFile("c:\Lotus.txt", ForAppending, True) permet d'écrire en append dans le fichier. L'option True autorise la création du fichier si celui-ci n'existe pas.

Option Explicit
Call ShowFilesLotus

Private Sub ShowFilesLotus()
Const HARD_DISK = 3
Dim objWMIService, colDisks, colFiles
Dim objDico, objTabExt, objDisk, objFile
Dim wshShell
Dim strComputer, i
Dim cles, strList
Dim ObjRapport, ObjFilerapportConst ForWriting 2, ForAppending 8

strComputer = "."

objTabExt = "nsf"

Set wshShell = Wscript.CreateObject ("Wscript.Shell")

Set ObjRapport = CreateObject("Scripting.FileSystemObject" )
Set ObjFileRapport = ObjRapport.OpenTextFile("c:\Lotus.txt", ForAppending, True)

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
    Set colFiles = objWMIService.ExecQuery _
                   ("Select * from CIM_DataFile where Drive = '" &_
                     objDisk.Name & "' And Extension = '" & objTabExt &"'")
    For Each objFile in colFiles
        objDico.Add objFile.Name,""
    Next
Next
Set colFiles =  Nothing
Set colDisks =  Nothing
Set objWMIService = Nothing

cles = objDico.Keys
For i = 0 To objDico.Count-1
    ObjFileRapport.Writeline wshShell.ExpandEnvironmentStrings ("%COMPUTERNAME%") _ 
                             &vbTab& cles(i) &vbCr
Next
ObjFileRapport.WriteBlankLines(2)
ObjFileRapport.close
Set objDico = Nothing
Set wshShell = Nothing
End Sub

jean-marc

mat76 · Answer

C'est exactement ce qu'il me fallait. Un grand merci pour votre aide.

Mathieu

mat76 · Answer

Bonjour,

Toujours par rapport à ce script, y a t'il un moyen d'exclure le répertoire Documents and Settings que la recherche?

Merci

cs_JMO · Answer

Bonsoir, La facilité serait For Each objDisk in colDisks Set colFiles = objWMIService.ExecQuery _ ("Select * from CIM_DataFile where Drive = '" &_ objDisk.Name & "' And Extension = '" & objTabExt &"'") For Each objFile in colFiles If Mid(LCase(objFile.Path),2, 22) <> "documents and settings" Then objDico.Add objFile.Name,"" End if Next Next Voir éventuellement la méthode ExpandEnvironmentStrings de l'objet WshShell. De même, on pourrait gérer les exceptions du folder dans la query en ajoutant Path <> exclusion. jean-marc

mat76 · Answer

Bonjour,

Une nouvelle fois merci.

Il est vrai que vous m'avez maché le travail mais en ayant un code qui marche j'ai pu comprendre le fonctionnement et même appliquer certaines fonctions (ajout de la date..) , bon je l'accorde des fonctions à ma mesure.

Encore une question, connaissez vous un bon tutoriel sur le vbs reprenant les fonctions de base etc... ( c'est pas le tout de demander de l'aide , le mieux est de comprendre ;) ).


 


Slts


Mathieu

mat76 · Answer

Finalement, j'ai encore une petite question. Pour l'exclusion de Documents and Settings cela marche. J'ai essayer de rajouter Program Files aussi mais sans résultat probant puisque lorsque que j'essai de rajouter Porgram Files à votre code, l'exclusion ne fonctionne plus.. J'ai essayer comme ca mais j'ai pas du avoir un bon feeling For Each objDisk in colDisks Set colFiles = objWMIService.ExecQuery _ ("Select * from CIM_DataFile where Drive = '" &_ objDisk.Name & "' And Extension = '" & objTabExt &"'") For Each objFile in colFiles If Mid(LCase(objFile.Path),2, 22) <> "documents and settings" or Mid(LCase(objFile.Path),2, 13) <> "program files" Then objDico.Add objFile.Name,"" End if Next Next Et ce n' est pas le premier essai de modification que j'ai fait... Comment puis je retirer de la recherche ces deux dossiers. Merci Slts

cs_JMO · Answer

Bonjour mat76, Pour exclure les 2 dossiers: If Mid(LCase(objFile.Path),2, 22) <> "documents and settings" And _ Mid(LCase(objFile.Path),2, 13) <> "program files" Then jean-marc

Recherche de fichier sur disque dur. [VBS]

9 réponses

Votre réponse

Discussions similaires