Recherche sur Disque partagé

[Rufian]

Bonjour à toutes & à tous !

Je souhaiterai faire une recherche complète d'un disque de serveur partagé (lettre réserau P), de tous les fichiers supérieur à 10 Mo, avec les informations telles que : Nom de fichier, taille, arborescence et date de modification. Toutes ces informations triées par colonne dans un fichier.
Par avance Merci de l'aide que vous pourriez m'apporter
Rufian

 

[titiborregan5]

Re : Recherche sur Disque partagé

Bonjour,
le forum m'avait aidé à faire une macro qui me permettait de chercher un fichier sur différents disques (locaux ou réseau) et qui donnait l'emplacement, le tout à partir d'un nom seul...

Peut-être que cela pourrait t'aider à commencer...

For Each d In Array("C", "I", "J", "K", "O", "P", "S", "U")
With Application.FileSearch
    .LookIn = d & ":\"
    .Filename = nom
    .SearchSubFolders = True
    n = .Execute
    If n > 0 Then
    'MsgBox "Trouvé", vbOKOnly, "ok"
    'MsgBox .FoundFiles(1)
    Cells(7, 1).Value = .FoundFiles(1) 'A7 note l'emplacement précis
    emp = Cells(7, 1).Value 'A7 s'appelle emp
   MsgBox "voila " & emp
    dest = "S:\XXX\" & nom
    FileCopy emp, dest
    Exit For
    Else: MsgBox "pas trouvé in " & d, vbOKOnly, "ko"
    End If
End With
Next d

Bon courage

Tibo

 

[jetted]

Re : Recherche sur Disque partagé

Ce n'est mon code mais je crois que cela t'aidera

Sub PopulateDirectoryList()
'dimension variables
Dim objFSO As FileSystemObject, objFolder As Folder
Dim objFile As File, strSourceFolder As String, x As Long, i As Long
Dim wbNew As Workbook, wsNew As Worksheet

ToggleStuff False 'turn of screenupdating

Set objFSO = New FileSystemObject  'set a new object in memory
strSourceFolder = BrowseForFolder 'call up the browse for folder routine
If strSourceFolder = "" Then Exit Sub

Workbooks.Add 'create a new workbook

Set wbNew = ActiveWorkbook
Set wsNew = wbNew.Sheets(1) 'set the worksheet
wsNew.Activate
'format a header
With wsNew.Range("A1:G1")
    .Value = Array("Parent", "File", "Size", "Modified Date", "Last Accessed", "Created Date", "Full Path", "Size")
    .Interior.ColorIndex = 7
    .Font.Bold = True
    .Font.Size = 12
End With

With Application.FileSearch
    .LookIn = strSourceFolder  'look in the folder browsed to
    .FileType = msoFileTypeAllFiles 'get all files
    .SearchSubFolders = True  'search sub directories
    .Execute  'run the search
           
    For x = 1 To .FoundFiles.Count 'for each file found, by the count (or index)
       i = x 'make the variable i = x
       If x > 60000 Then  'if there happens to be more than multipls of 60,000 files, then add a new sheet
          i = x - 60000  'set i to the right number for row placement below
          Set wsNew = wbNew.Sheets.Add(after:=Sheets(wsNew.Index))
          With wsNew.Range("A1:G1")
            .Value = Array("Parent", "File", "Parent Folder", "Full Path", "Modified Date", _
                                               "Last Accessed", "Size")
            .Interior.ColorIndex = 7
            .Font.Bold = True
            .Font.Size = 12
           End With

       End If
        On Error GoTo Skip 'in the event of a permissions error
          
        Set objFile = objFSO.GetFile(.FoundFiles(x)) 'set the object to get it's properties
         With wsNew.Cells(1, 1) 'populate the next row with the variable data
             .Offset(i, 0) = objFile.ParentFolder
             .Offset(i, 1) = objFile.Name
             .Offset(i, 2) = Format(objFile.Size, "0,000") & " KB"
             .Offset(i, 3) = objFile.DateLastModified
             .Offset(i, 4) = objFile.DateLastAccessed
             .Offset(i, 5) = objFile.DateCreated
             .Offset(i, 6) = objFile.Path
             
         End With
          ' Next objFile
Skip:
'this is in case a Permission denied error comes up or an unforeseen error
'Do nothing, just go to next file
     Next x
wsNew.Columns("A:G").AutoFit

End With

'clear the variables
Set objFolder = Nothing
Set objFile = Nothing
Set objFSO = Nothing
Set wsNew = Nothing
Set wbNew = Nothing
       
ToggleStuff True 'turn events back on
End Sub
Sub ToggleStuff(ByVal x As Boolean)
Application.ScreenUpdating = x
Application.EnableEvents = x
End Sub


Function BrowseForFolder(Optional OpenAt As Variant) As Variant
    '''Code from kpuls, www.VBAExpress.com..portion of Knowledge base submission
     
  Dim ShellApp As Object
  Set ShellApp = CreateObject("Shell.Application"). _
    BrowseForFolder(0, "Please choose a folder", 0, OpenAt)
     
    On Error Resume Next
    BrowseForFolder = ShellApp.self.Path
    On Error GoTo 0
     
    Set ShellApp = Nothing
     
    Select Case Mid(BrowseForFolder, 2, 1)
        Case Is = ":"
            If Left(BrowseForFolder, 1) = ":" Then GoTo Invalid
        Case Is = "\"
            If Not Left(BrowseForFolder, 1) = "\" Then GoTo Invalid
        Case Else
            GoTo Invalid
        End Select
    Exit Function

Invalid:
   
    
ToggleStuff True
End Function

 

[Rufian]

Re : Recherche sur Disque partagé

Hello à vous 2 !

Merci beaucoup pour cette aide, je n'ai pas essayé les 2 propositions, mais je sais que "Application.FileSearch" est inconnu dans la version d'Excel (2007).
Mais je vais tester
Encore MERCI de l'aide