Aantal bestanden in een map tellen met VBA (Excel macro)

[Verberkmoes]

#18: Die Library is inderdaad standaard niet ingeschakeld.
Daarom lijkt me het beter om Dim .... As Object te gebruiken. Of is dat onzin?

 

[edmoor]

Het is geen onzin, maar in dit geval ook niet nodig.

 

[JEC.]

Zonder verwijzing naar een library dus zo

Sub jec()
 XPath = "C:\Users\Bert Verberkmoes\Desktop\MAN_5011_FFT_Various_Ranges\"
 For Each it In CreateObject("scripting.filesystemobject").getfolder(XPath).Files
    If it.Name Like "*RVD" Then x = x + 1
 Next
 MsgBox x
End Sub

 

[HSV]

en bij Ubound 1 optellen......

Hier niet.

 

[snb]

Dan liever:

Sub M_snb()
 with CreateObject("scripting.filesystemobject").getfolder("C:\Users\Bert Verberkmoes\Desktop\MAN_5011_FFT_Various_Ranges\")
   For Each it In .Files
    If right(lcase(it.Name),4)=".rvd" Then x = x + 1
   Next
 end with

 MsgBox x
End Sub

 

[JEC.]

Geen ubound + 1 nodig omdat er altijd nog een lege extra waarde in de array wordt gezet
In de cel zie je het en na splitten zie je het ook

Cells(1, 1).Value = CreateObject("wscript.shell").exec("cmd /c Dir ""C:\Users\Bert Verberkmoes\Desktop\MAN_5011_FFT_Various_Ranges\*.rvd"" /b").stdout.readall

 

[JEC.]

@Snb,

Dan lijkt me deze nog beter, nu we toch bezig zijn
Verschil tussen de 3 zul je in ieder geval niet merken

Sub jec()
 With CreateObject("scripting.filesystemobject")
    For Each it In .getfolder("C:\Users\Bert Verberkmoes\Desktop\MAN_5011_FFT_Various_Ranges\").Files
      If .GetExtensionName(it) = "rvd" Then x = x + 1
    Next
 End With
 MsgBox x
End Sub

 

[snb]

Jawel bij grote aantallen.
Voorkom overbodige variabelen.
Voorkom dat een bewerking (getfolder) onnodig vaak wordt uitgevoerd.

Sub M_snb()
  With CreateObject("scripting.filesystemobject").getfolder("C:\Users\Bert Verberkmoes\Desktop\MAN_5011_FFT_Various_Ranges\")
    For Each it In .Files
       x = x - (.parent.getExtensionName(it) = "rvd")
    Next
  End With MsgBox x
End Sub

 

[JEC.]

Na 1x uitvoeren is die voor de complete lus toch geladen? Of wordt die steeds opnieuw uitgevoerd binnen een loop, kan het bijna niet geloven.

 

[JEC.]

Zojuist getest met 2000 files.
Alles even snel, het object zal niet steeds opnieuw geladen worden binnen de lus

Sub test()
 t = Timer
 ReDim ar(2000)
 
 With CreateObject("scripting.filesystemobject")
    For Each it In .getfolder("C:\Users\xxx\Downloads\").Files
      If .getextensionname(it) = "xlsx" Then
        ar(x) = it.Name
        x = x + 1
      End If
    Next
 End With
 
 Cells(1, 1).Resize(x) = Application.Transpose(ar)
 MsgBox Timer - t
End Sub

Sub testt()
 t = Timer
 ReDim ar(2000)
  
 With CreateObject("scripting.filesystemobject").getfolder("C:\Users\xxx\Downloads\")
    For Each it In .Files
       If it.Name Like "*xlsx" Then
         ar(x) = it.Name
         x = x + 1
       End If
    Next
 End With
  
 Cells(1, 1).Resize(x) = Application.Transpose(ar)
 MsgBox Timer - t
End Sub

Sub testtt()
 t = Timer
 ReDim ar(2000)
 XPath = "C:\Users\xxx\Downloads\"
 
 For Each it In CreateObject("scripting.filesystemobject").getfolder(XPath).Files
   If it.Name Like "*xlsx" Then
      ar(x) = it.Name
      x = x + 1
    End If
 Next
 
 Cells(1, 1).Resize(x) = Application.Transpose(ar)
 MsgBox Timer - t
End Sub