I haven't been able to find many examples of how to create a treeview directory of files and folders in the system in a treeview control for Excel VBA. I have come up with some code that will do it, but it's really touchy (sometimes identical node keys are generated or I run out of room in the stack). The code uses a combobox that lists available drives and that is the root directory. The node key for each file is its full path in the directory. The keys for the folders are their names and then a number correlating to the number of folder it is in the full path, skipping the first (In "E:\Music\Artist\Album\Song.mp3" The node for "Artist" would have a key named "Artist1". If someone could tell me where to get some better examples, or help make my code more usable I would appreciate it! Thanks in advance.
Private Sub UserForm_Initialize()
Dim oFileSysObj As Object
Dim oDrive As Object
Set oFileSysObj = CreateObject("Scripting.FileSystemObject")
With Me.ComboBox1
For Each oDrive In oFileSysObj.Drives
.AddItem oDrive.DriveLetter & ":\"
Next
.Value = .List(0)
End With
Call UpdateTree
End Sub
Sub UpdateTree()
Dim MnFldrs() As String
Dim Addlst() As String
Dim cPrntlst() As String
Dim Prntlst() As String
Dim NwStrSrch() As String
With Application.FileSearch
.NewSearch
.LookIn = Me.ComboBox1.Value
.filename = "*.mp3;*.wma;*.wav"
.SearchSubFolders = True
.Execute
ReDim MnFldrs(.FoundFiles.Count)
ReDim Addlst(.FoundFiles.Count)
ReDim cPrntlst(.FoundFiles.Count)
ReDim Prntlst(.FoundFiles.Count)
For num = 1 To .FoundFiles.Count
MnFldrs(num) = Right(.FoundFiles(num), Len(.FoundFiles(num)) - 3)
Next num
Set xx = Me.TreeView1.Nodes.Add(, , Me.ComboBox1.Value & "1", Me.ComboBox1.Value)
Set xx = Nothing
rnd1 = 1
num = 1
Prntlst(num) = Me.ComboBox1.Value
Do
Do Until InStr(MnFldrs(num), "\") <> 0 Or num = .FoundFiles.Count
num = num + 1
Loop
If num = .FoundFiles.Count And InStr(MnFldrs(num), "\") = 0 Then GoTo out
CrntFldr = Left(MnFldrs(num), InStr(MnFldrs(num), "\") - 1)
MnFldrs(num) = Right(MnFldrs(num), Len(MnFldrs(num)) - InStr(MnFldrs(num), "\"))
Addlst(num) = CrntFldr
cPrntlst(num) = Prntlst(num)
Prntlst(num) = CrntFldr
c2t = num
For dum = num + 1 To .FoundFiles.Count
ChckFldr = Left(MnFldrs(dum), InStr(MnFldrs(dum), "\") - 1)
MnFldrs(dum) = Right(MnFldrs(dum), Len(MnFldrs(dum)) - InStr(MnFldrs(dum), "\"))
c3t = 1
rTrn = 1
Do Until c3t = 50 Or rTrn = 0
rTrn = StrComp(ChckFldr, Addlst(c3t), vbBinaryCompare)
c3t = c3t + 1
Loop
If rTrn = 0 Then
Prntlst(dum) = ChckFldr
Else: c2t = c2t + 1: Addlst(c2t) = ChckFldr: cPrntlst(c2t) = Prntlst(dum): Prntlst(dum) = ChckFldr
End If
ReDim NwStrSrch(0)
Next dum
For gum = LBound(Addlst) + 1 To UBound(Addlst)
If Addlst(gum) <> "" Then
If cPrntlst(gum) = "" Then cPrntlst(gum) = Prntlst(num)
If rnd1 <> 1 Then
addstr = CStr(rnd1 - 1)
Else: addstr = "1"
End If
Set xx = Me.TreeView1.Nodes.Add(cPrntlst(gum) & addstr, 4, Addlst(gum) & rnd1, Addlst(gum))
Set xx = Nothing
End If
Next gum
rnd1 = rnd1 + 1
Loop
out:
For yum = 1 To .FoundFiles.Count
c4t = c4t + 1
rNdnum = InStr(.FoundFiles(yum), "\")
RtRnval = 1
c5t = 0
Do Until c5t = .FoundFiles.Count Or RtRnval = 0
c5t = c5t + 1
cmpStr = Right(Left(.FoundFiles(c5t), InStrRev(.FoundFiles(c5t), "\") - 1), Len(Left(.FoundFiles(c5t), _
InStrRev(.FoundFiles(c5t), "\") - 1)) - InStrRev(Left(.FoundFiles(c5t), InStrRev(.FoundFiles(c5t), "\") - 1), "\")) _
& Right(.FoundFiles(c5t), Len(.FoundFiles(c5t)) - InStrRev(.FoundFiles(c5t), "\") + 1)
RtRnval = StrComp(Prntlst(yum) & "\" & MnFldrs(yum), cmpStr, vbBinaryCompare)
Loop
Set xx = Me.TreeView1.Nodes.Add(Prntlst(yum) & rNdnum, 4, .FoundFiles(c5t), MnFldrs(yum))
Set xx = Nothing
Next yum
End With
End Sub
Private Sub UserForm_Initialize()
Dim oFileSysObj As Object
Dim oDrive As Object
Set oFileSysObj = CreateObject("Scripting.FileSystemObject")
With Me.ComboBox1
For Each oDrive In oFileSysObj.Drives
.AddItem oDrive.DriveLetter & ":\"
Next
.Value = .List(0)
End With
Call UpdateTree
End Sub
Sub UpdateTree()
Dim MnFldrs() As String
Dim Addlst() As String
Dim cPrntlst() As String
Dim Prntlst() As String
Dim NwStrSrch() As String
With Application.FileSearch
.NewSearch
.LookIn = Me.ComboBox1.Value
.filename = "*.mp3;*.wma;*.wav"
.SearchSubFolders = True
.Execute
ReDim MnFldrs(.FoundFiles.Count)
ReDim Addlst(.FoundFiles.Count)
ReDim cPrntlst(.FoundFiles.Count)
ReDim Prntlst(.FoundFiles.Count)
For num = 1 To .FoundFiles.Count
MnFldrs(num) = Right(.FoundFiles(num), Len(.FoundFiles(num)) - 3)
Next num
Set xx = Me.TreeView1.Nodes.Add(, , Me.ComboBox1.Value & "1", Me.ComboBox1.Value)
Set xx = Nothing
rnd1 = 1
num = 1
Prntlst(num) = Me.ComboBox1.Value
Do
Do Until InStr(MnFldrs(num), "\") <> 0 Or num = .FoundFiles.Count
num = num + 1
Loop
If num = .FoundFiles.Count And InStr(MnFldrs(num), "\") = 0 Then GoTo out
CrntFldr = Left(MnFldrs(num), InStr(MnFldrs(num), "\") - 1)
MnFldrs(num) = Right(MnFldrs(num), Len(MnFldrs(num)) - InStr(MnFldrs(num), "\"))
Addlst(num) = CrntFldr
cPrntlst(num) = Prntlst(num)
Prntlst(num) = CrntFldr
c2t = num
For dum = num + 1 To .FoundFiles.Count
ChckFldr = Left(MnFldrs(dum), InStr(MnFldrs(dum), "\") - 1)
MnFldrs(dum) = Right(MnFldrs(dum), Len(MnFldrs(dum)) - InStr(MnFldrs(dum), "\"))
c3t = 1
rTrn = 1
Do Until c3t = 50 Or rTrn = 0
rTrn = StrComp(ChckFldr, Addlst(c3t), vbBinaryCompare)
c3t = c3t + 1
Loop
If rTrn = 0 Then
Prntlst(dum) = ChckFldr
Else: c2t = c2t + 1: Addlst(c2t) = ChckFldr: cPrntlst(c2t) = Prntlst(dum): Prntlst(dum) = ChckFldr
End If
ReDim NwStrSrch(0)
Next dum
For gum = LBound(Addlst) + 1 To UBound(Addlst)
If Addlst(gum) <> "" Then
If cPrntlst(gum) = "" Then cPrntlst(gum) = Prntlst(num)
If rnd1 <> 1 Then
addstr = CStr(rnd1 - 1)
Else: addstr = "1"
End If
Set xx = Me.TreeView1.Nodes.Add(cPrntlst(gum) & addstr, 4, Addlst(gum) & rnd1, Addlst(gum))
Set xx = Nothing
End If
Next gum
rnd1 = rnd1 + 1
Loop
out:
For yum = 1 To .FoundFiles.Count
c4t = c4t + 1
rNdnum = InStr(.FoundFiles(yum), "\")
RtRnval = 1
c5t = 0
Do Until c5t = .FoundFiles.Count Or RtRnval = 0
c5t = c5t + 1
cmpStr = Right(Left(.FoundFiles(c5t), InStrRev(.FoundFiles(c5t), "\") - 1), Len(Left(.FoundFiles(c5t), _
InStrRev(.FoundFiles(c5t), "\") - 1)) - InStrRev(Left(.FoundFiles(c5t), InStrRev(.FoundFiles(c5t), "\") - 1), "\")) _
& Right(.FoundFiles(c5t), Len(.FoundFiles(c5t)) - InStrRev(.FoundFiles(c5t), "\") + 1)
RtRnval = StrComp(Prntlst(yum) & "\" & MnFldrs(yum), cmpStr, vbBinaryCompare)
Loop
Set xx = Me.TreeView1.Nodes.Add(Prntlst(yum) & rNdnum, 4, .FoundFiles(c5t), MnFldrs(yum))
Set xx = Nothing
Next yum
End With
End Sub