Lijst/Teller van bestandsextensies in map+submappen VBA

Status
Niet open voor verdere reacties.
W

Waldorf79

Gebruiker
Lid geworden
7 dec 2011
Berichten
29
Office versie
magDer
Heren,

ik ben al even aan 't knoeien met VBA, maar ik kom er niet uit.
Kunnen jullie me even op weg helpen?

Wat ik wil bereiken is het volgende:

-Scannen op bestaande extensies in map + submappen
-Oplijsten welke extensies er gebruikt worden
-Tellen hoeveel bestanden er zijn van de bijhorende extensies

Lijkt me niet zo moeilijk, maar eerlijk gezegd geen idee hoe er aan te beginnen.

Wie helpt me op weg?

thx!
 
Toeval wil dat ik enkele jaren geleden een class module gemaakt heb om het FileSearch Object te vervangen. Ik las toen bij verschillende bronnen dat dit FileSearch Object vanaf Office 2007 niet meer zou bestaan, maar dat heb ik (nog) niet kunnen achterhalen want ik werk nog steeds met 2003. Gebruik makende van deze class module (of van het FileSearch Object, mocht dat nog bestaan) is het niet echt moeilijk om de extensies in een folder + subfolders te scannen en op te lijsten. Zie bijlage. Vul de folder in in de cel "E1". Let op: er is geen controle op de geldigheid van de ingevulde folder.

Grtz,
MDN111.
 

Bijlagen

Op grond waarvan denk je dat het niet zo moeilijk is ?
 
Topic kan sluiten want mdm111 zijn oplossing bleek direct ook wat ik zocht! Waarvoor dank!
 
Mag je zelf doen. Sterker nog: moet je zelf doen!
 
@Waldorf79

Wat doet jou veronderstellen dat alleen heren dit forum bezoeken of jouw vraag kunnen beantwoorden ?

@MDN111

Filesearch kan vervangen worden door 1 alternatieve VBA regel.
Toegepast op de vraag in deze draad:

Code: 
Sub M_snb()
    sn = Filter(Filter(Split(LCase(CreateObject("wscript.shell").exec("cmd /c dir ""[COLOR="#008080"][B]G:\OF[/B][/COLOR]\*.?*"" /b /s").stdout.readall), vbCrLf), ":"), ".")
    
    With CreateObject("scripting.filesystemobject")
        Do Until UBound(sn) = -1
           c01 = "." & .GetExtensionName(sn(0))
           c00 = c00 & vbLf & c01 & "_" & UBound(Filter(sn, c01)) + 1
           sn = Filter(sn, c01, False)
        Loop
    End With
    
    sp = Split(Mid(c00, 2), vbLf)
    Cells(1).Resize(UBound(sp)) = Application.Transpose(sp)
    Columns(1).TextToColumns , , , , 0, 0, 0, 0, -1, "_"
End Sub

NB. Vervang G:\OF door de folder waarin jij wil zoeken.
 
@snb

Helaas maakt hij geen onderscheid tussen .xls, .xlsx en .xlsm bestanden en telt alles samen wat begint met .xls
 
@WB

Ik hoopte op een fraaie suggestie van jouw kant....
Zoals bijv.

Code: 
Sub M_snb()
    sn = Filter(Split(Replace(LCase(CreateObject("wscript.shell").exec("cmd /c dir ""[COLOR="#008080"][B]G:\OF[/B][/COLOR]\*.?*"" /b /s").stdout.readall), vbCrLf, "_" & vbCrLf), vbCrLf), ".")
    
    Do Until UBound(sn) = -1
       c01 = Mid(sn(0), InStrRev(sn(0), "."))
       c00 = c00 & vbLf & c01 & UBound(Filter(sn, c01)) + 1
       sn = Filter(sn, c01, False)
    Loop
    
    sp = Split(Mid(c00, 2), vbLf)
    Cells(1).Resize(UBound(sp)+1) = Application.Transpose(sp)
    Columns(1).TextToColumns , , , , 0, 0, 0, 0, -1, "_"
End Sub
 
Laatst bewerkt:
@Warme bakkertje

Ik vrees dat ik even niet mee ben. Waarom maakt .GetExtensionName geen onderscheid tussen .xls, .xlsx en .xlsm bestanden? Ik heb eens enkele bestanden een andere naam gegeven met een extensie van wel 10 letters (bijvoorbeeld .aaaaaaaaaa) en die haalt hij er wel uit. :confused:

@snb

Of het nu over het FileSearch object ging of over iets anders weet ik niet meer, maar ik herinner mij dat ik ooit eens het Wscript.shell object bestudeerd heb, maar ik heb dat toen links laten liggen omdat ik ergens gelezen had dat men de Windows Scripting Host buiten dienst kan zetten. Dat gebeurt misschien uiterst zelden, maar dan is dat object niet ter beschikking. Wat niet wegneemt dat ik uw code zeker kan apreciëren (lees:genieten), zonder mij te schamen voor m'n eigen code. Er was enige tijd geleden een topic waarin ik had aangeraden een API call te gebruiken en daarvoor had u een beter alternatief gegevens dat volledig binnen VBA lag. In dit geval vind ik dat mijn oplossing met een class module gebaseerd op de Dir() functie meer binnen VBA ligt dan code die gebruikt maakt van een extern object. ;) Niettemin heb ik uit je code toch weeral flink wat bijgeleerd. :thumb:

Grtz,
MDN111.
 
@MDN111

De .getextensionname is niet de boosdoener, maar de filter methode.
Maar dat is in mijn laatste suggestie ondervangen.

Ik zou niet weten hoe je een ingebouwde bibliotheek zou kunnen uitschakelen of waarom je dat zou willen.
Gebruik van de wscript.shell VBA bibliotheek is niet anders dan het gebruik van de Excel VBA bibliotheek.
Dat is toch echt wat anders dan het gebruik van een API call.
 
@snb

1.
Oef ! Dat was even zoeken. Ik dacht al bij mezelf "Wat zegt die snb nou allemaal? .getextensionname is niet de boosdoener, maar juist de regel waar die methode in voorkomt, wijzigt hij." Na betere analyse denk ik dat ik mee ben. In de MSDN-library heb ik de reden gevonden: "Another potential problem with using the Filter function to search an array is that there's no way to specify whether the search text should match the entire element, or whether it need only match a part of it". Dus als je aan de extensie .xls toegekomen bent, dan worden inderdaad de extensies .xlsx en .xlsm ook mee gefilterd. Hetzelfde gebeurt bij .htm en .html.

2.
Ik dacht dan even de slimme uit te hangen door de eerste regel van uw eerste code als volgt aan te passen:
Code: 
sn = Filter(Filter(Split(LCase(CreateObject("wscript.shell").exec("cmd /c dir ""G:\OF\*.?*"" /b /s [COLOR="#FF0000"][B]/o-e[/B][/COLOR]").stdout.readall), vbCrLf), ":"), ".")
zo komen de extensies .xlsm en .xlsx vóór .xls en worden ze er niet uitgefilterd. Dat werkt wel, maar er onstaat een andere tekortkoming. Ik had nameijk een subfolder een naam gegeven met een extensie en voor ieder bestand in die subfolder heeft hij de extensie van de foldernaam genomen in plaats van de bestandsextensie. Hier kwam ik dus bedrogen uit.


3.
Omdat ik toch een volledig inzicht in uw code wilde krijgen heb ik dan de vier opties getest. Je eerste code, je eerste code aangepast met /o-e, je tweede code en m'n eigen code. De eerder vastgestelde gebreken werden bevestigd, maar daar wisten we de oplossing reeds van, doch er was een extensie .wmv die maar niet in de lijst wilde voorkomen. Die extensie zat in de string c00 en ook in de array sp en toch kwam ze niet in de Excel-sheet terecht. Het bleek over de 9de regel te gaan. Het aantal rijen van de .resize-property begint te tellen vanaf 1, terwijl UBound(sp) zero based is. Na de volgende aanpassing was alles normaal.
Code: 
Cells(1).Resize(UBound(sp) [COLOR="#FF0000"][B]+ 1[/B][/COLOR]) = Application.Transpose(sp)

4.
Het is misschien een beetje te ver gezocht om te denken dat de WSH uitgeschakeld kan zijn, maar ik lees op verschillende sites dat men het om veiligheidsredenen aanbeveelt, bijvoorbeeld http://bucarotechelp.com/computers/winadmin/95090301.asp. Bij mij staat de WSH niet uitgeschakeld en ik heb evenmin een idee of andere die uitschakelen.

Grtz,
MDN111.
 
Code: 
Sub M_snb()
    sn = Filter(Split(Replace(LCase(CreateObject("wscript.shell").exec("cmd /c dir ""G:\Mijn documenten\Helpmij\*.?*"" /b /s").stdout.readall), vbCrLf, "_" & vbCrLf), vbCrLf), ".")
    
    Do Until UBound(sn) = -1
       c01 = Mid(sn(0), InStrRev(sn(0), "."))
       c00 = c00 & vbLf & c01 & UBound(Filter(sn, c01)) + 1
       sn = Filter(sn, c01, False)
    Loop
    
    sp = Split(Mid(c00, 2), vbLf)
    With Cells(1)
        .Resize(UBound(sp) + 1) = Application.Transpose(sp)
        With .CurrentRegion
            .Sort Cells(1), xlAscending
        End With
    End With
    Columns(1).TextToColumns , , , , 0, 0, 0, 0, -1, "_"
End Sub

En zo krijg je hem dan netjes gesorteerd.:D
 
@wb

Zou dit dan niet volstaan ? :p

Code: 
With Cells(1)
  .Resize(UBound(sp) + 1) = Application.Transpose(sp)
  .Sort Cells(1)
End With
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan