Klik hier om in te loggen
Je bent momenteel niet ingelogd
Topic Mappen en Bestanden woensdag 2 april 2008 om 23:20
Carharttguy
Administrator
46 posts
Hoi,

Ik zoek dus naar een manier om alle mappen + alle bestanden op een computer in array's te krijgen.

Ik krijg ze wel in Dirlistbox en Filelistbox enzo, maar ik krijg daar geen namen uit? Anders kon ik ze er met een loop ofzo uithalen.

Nu dan, in een listview kanje wel gegevens halen, maar nu is de vraag, hoe krijg ik de mappen en de bijbehorende submappen en bestanden in een listview?

Dus eigenlijk wil ik hetzelfde als een dirlistbox en filelistbox maar dan met eigen strings, die ik dan kan verzenden en dergelijke. Ik hoop dat je een manier kent.

alvast bedankt!
Reageer Quote dit bericht Bewerken Privé bericht zendenwoensdag 2 april 2008 om 23:20
RoelVB
Webmaster
108 posts
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 Smiley


-edit-
Oja... als je bestanden van een bepaalde extensie wilt weergeven, bijvoorbeeld .jpg, dan gebruik je in de functie als extensie "*.jpg" Smiley
Reageer Quote dit bericht Bewerken Privé bericht zendenvrijdag 4 april 2008 om 18:40
Carharttguy
Administrator
46 posts
Bedankt Smiley
Reageer Quote dit bericht Bewerken Privé bericht zendenvrijdag 4 april 2008 om 19:46