Bestanden vinden en weergeven in een lijst

[1107972]

Hallo,

Had een tijdje geleden een macro gemaakt die bestanden in een map en submappen kon vinden en die kon weergeven in een lijst. Nu was dat met een oude excel versie toen de functie filesearch nog werkte. Echter nu heb ik zowel thuis als op mijn werk 2007 en werkt dus niet meer. Heb wel een workaround gevonden van dhr SNB, dit het trouwens fantastisch doet maar echter niet verder zoekt in de submappen. Nu is mijn vraag of deze code eventueel aangepast kan worden zodat hij ook de bestanden in de submappen kan vinden. Hiermee zou ik enorm geholpen zijn en alvast bedankt.

Sub tst()
  c0 = "Bestandsnamen"
  With CreateObject("scripting.filesystemobject").GetFolder(InputBox("Welke directory wenst U", "FileSearch", "G:\2008"))
    For Each fl In .Files
        If Right(fl.Name, 4) = ".avi" Then c0 = c0 & fl.Name & "|"
    Next
    [A:A].ClearContents
    [A1].Resize(UBound(Split(c0, "|"))) = WorksheetFunction.Transpose(Split(c0, "|"))
  End With
End Sub

 

[snb]

dhr (???) Snb

Sub tst()
  c0 = "Bestandsnamen"
  With CreateObject("scripting.filesystemobject").GetFolder(InputBox("Welke directory wenst U", "FileSearch", "G:\2008"))
    For Each fl In .Files
        If Right(fl.Name, 4) = ".avi" Then c0 = c0 & fl.Name & "|"
    Next
    for each sfl in .subfolders
      For Each fl In sfl.Files
        If Right(fl.Name, 4) = ".avi" Then c0 = c0 & sfl.name & "/" &fl.Name & "|"
      Next
    Next
    [A:A].ClearContents
    [A1].Resize(UBound(Split(c0, "|"))) = WorksheetFunction.Transpose(Split(c0, "|"))
  End With
End Sub

 

[1107972]

Fantastisch, precies wat ik zocht, kan ik mooi verder er weer een boel code omheen gaan maken. Maar heerlijk om te zien hoe lekker compact de code is. Maakt het voor mij een stuk makkelijker om er weer wat van te leren.

Enne, was dhr niet goed en ben ik geholpen door een dame?

Bedankt voor de hulp.

 

[1107972]

Ik ben gisteren iets te voorbarig geweest met juichen. Ben ondertussen al wat verder gaan spelen met de code maar kwam er achter dat hij soms nog wel eens wil vast lopen als er bijvoorbeeld geen resultaten gevonden worden. De regel waar hij dan vastloopt is "For Each fl In sfl.Files".

Het tweede waar ik tegen aan loopt is dat hij enkel de eerste submappen en niet de volgende lagen submappen doorzoekt. Hopelijk is het niet teveel gevraagd maar is het mogelijk om hier een soort intelligentie in te bouwen die alle onderliggende lagen doorzoekt.

Indien dit niet mogelijk is of gewoon te tijdrovend wat ik ook goed begrijp ben ik al tevreden als hij tot de 5e submap kan zoeken en er geen problemen mee heeft als daar niks gevonden word of dat er bijvoorbeeld maar 3 submappen zijn.

Hier de code waar ik tot nu toe mee bezig ben geweest.

Sub Doorzoeken()

Dim Search_Dir As String 'Te doorzoeken locatie
Dim Search_Ext As String 'Te zoeken extensie

Search_Dir = "G:\2008"
Search_Ext = "Avi"
Search_Ext = "." & LCase(Search_Ext)

MsgBox (Search_Dir & Search_Ext)

  With CreateObject("scripting.filesystemobject").GetFolder(Search_Dir)
    
    'Zoeken in hoofdmap
    For Each fl In .Files
        If LCase(Right(fl.Name, Len(Search_Ext))) = Search_Ext Then c0 = c0 & fl.Path & "|"
    Next
    
    'Zoeken in eerste submap
    For Each sfl In .SubFolders
      For Each fl In sfl.Files
        If LCase(Right(fl.Name, Len(Search_Ext))) = Search_Ext Then c0 = c0 & fl.Path & "|"
      Next
    Next
       
    [A1].Resize(UBound(Split(c0, "|"))) = WorksheetFunction.Transpose(Split(c0, "|"))

  End With
End Sub

 

[snb]

Kijk hier voor een oplossing tot 20 nivo's diep.