Even deze code in een module droppen:
Code |
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73
|
Option Explicit
Public Type tSearch
Count As Long
Path As New Collection
Size As New Collection
DateTime As New Collection
Attr As New Collection
End Type
Public Sub GetFiles(sDir As String, sFilter As String, FileAttr As VbFileAttribute, cCol As tSearch)
Dim lTmp1 As Long
Dim lTmp2 As Long
Dim lTmp3 As Long
Dim sStr1 As String
Dim sStr2 As String
Dim sStr3 As String
Dim sResult1() As String
Dim sResult2() As String
sStr2 = ""
For lTmp1 = 0 To sSplit(sDir, "", sResult1)
sResult1(lTmp1) = Trim\$(sResult1(lTmp1))
If Right\$(sResult1(lTmp1), 1) <> "\" Then
sResult1(lTmp1) = sResult1(lTmp1) + "\"
End If
If InStr(sStr2, UCase\$(sResult1(lTmp1)) + ";") < 1 Then
sStr2 = sStr2 + UCase\$(sResult1(lTmp1)) + ";"
sStr3 = ""
For lTmp2 = 0 To sSplit(sFilter, "", sResult2)
sResult2(lTmp2) = Trim\$(sResult2(lTmp2))
If InStr(sStr3, UCase\$(sResult2(lTmp2)) + ";") < 1 Then
sStr3 = sStr3 + UCase\$(sResult2(lTmp2)) + ";"
sStr1 = Dir\$(sResult1(lTmp1) + sResult2(lTmp2), FileAttr)
DoEvents
While sStr1 <> ""
cCol.Path.Add sResult1(lTmp1) + sStr1
cCol.Size.Add FileLen(sResult1(lTmp1) + sStr1)
cCol.DateTime.Add FileDateTime(sResult1(lTmp1) + sStr1)
cCol.Attr.Add GetAttr(sResult1(lTmp1) + sStr1)
sStr1 = Dir
Wend
End If
Next
End If
Next
cCol.Count = cCol.Path.Count
End Sub
Private Function sSplit(ByVal sStr1 As String, sDelims As String, sResult() As String) As Long
Dim nResult As Long
Dim lTmp1 As Long
Dim lTmp2 As Long
If sDelims = "" Then
sDelims = ";" + Chr\$(0) + Chr\$(9) + Chr\$(10) + Chr\$(13)
End If
If InStr(1, Right\$(sStr1, 1), sDelims, vbBinaryCompare) < 1 Then
sStr1 = sStr1 + Left\$(sDelims, 1)
End If
nResult = -1
lTmp1 = 1
For lTmp2 = 1 To Len(sStr1)
If InStr(1, sDelims, Mid\$(sStr1, lTmp2, 1), vbBinaryCompare) > 0 Then
nResult = nResult + 1
ReDim Preserve sResult(0 To nResult) As String
sResult(nResult) = Mid\$(sStr1, lTmp1, lTmp2 - lTmp1)
lTmp1 = lTmp2 + 1
End If
Next
If lTmp1 < 3 Then
nResult = -1
End If
sSplit = nResult
End Function
|
deze functie kun je dan gebruiken om bestanden in een listbox te zetten:
Code |
1 2 3 4 5 6 7 8 9 10 11 12 13 14
|
Function LaadBestanden(Pad As String, Lijst As ListBox, Optional Extensie As String = "*")
Dim lTmp1 As Long
Dim cCol As tSearch
Dim Path As String
Lijst.Clear
GetFiles Pad, Extensie, vbArchive, cCol
For lTmp1 = 1 To cCol.Count
Path = cCol.Path(lTmp1)
Path = Mid\$(Path, InStr(Path, Pad) + Len(Pad))
'Path = Left(Path, Len(Path) - 4)
Lijst.AddItem Path
Next
End Function
|
Als je voor het stuk code dat als comment staat de ' weg haalt worden bestanden in de listbox gezet zonder extensie
-edit-
Oja... als je bestanden van een bepaalde extensie wilt weergeven, bijvoorbeeld .jpg, dan gebruik je in de functie als extensie "*.jpg"