Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations gkittelson on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Treeview System File/Folder Directory in UserForm

Status
Not open for further replies.

mnik3

Technical User
May 11, 2009
10
US
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
 
Well, nobody replied, but I did some digging on MSDN today and this is what I came up with if anybody else wants help with this project. Works like a dream.

Private Sub UserForm_Initialize()
Me.TreeView1.ImageList = Me.ImageList1 'I have an image of a folder as Image1 and an icon as Image2
InitialTreeRootDir 'This populates the treeview upon loading the form with all of the root directory drives
End Sub

Sub InitialTreeRootDir()
Dim fso As Object
Dim rDir As Object
Set fso = CreateObject("Scripting.FileSystemObject") 'create reference to the scripting library
For Each rDir In fso.Drives 'Loop through drives
nInfo = rDir.DriveLetter & ":\"
If nInfo <> "K:\" Then Set xx = Me.TreeView1.Nodes.Add(, , nInfo, nInfo, 1)'Add drive to Treeview and set image
FillTreeDir (nInfo) 'Prepare the treeview for expansion by setting only the next level in directory
Next
End Sub

Sub FillTreeDir(rFolder As String)
Dim fso As Object
Dim oFolder As Object
Dim sFolder As Object
Dim dFolder As Object
Set fso = CreateObject("Scripting.FileSystemObject")
On Error GoTo exit1 'This exists in case the user does not have administrator rights
Set oFolder = fso.GetFolder(rFolder) 'retrieve the folder path as an object
Set sFolder = oFolder.SubFolders
For Each dFolder In sFolder 'Loop through subfolders
PrntFldr = dFolder.ParentFolder: nKey = dFolder.path: nName = dFolder.Name 'Set attributes
Set xx = Me.TreeView1.Nodes.Add(PrntFldr, 4, nKey, nName, 1)
Next
rFolFile = GetFileInfo(rFolder) 'retrieve any files in current level
For AddFile = 1 To UBound(rFolFile)
If rFolFile(AddFile, 1) = "" Then Exit Sub 'name will be empty if file is of the wrong type
Set xx = Me.TreeView1.Nodes.Add(rFolFile(AddFile, 3), 4, rFolFile(AddFile, 2), rFolFile(AddFile, 1), 2)
Next AddFile
exit1:
End Sub

Function GetFileInfo(rFolder As String)
Dim FileInfo() As String
Dim fso As Object
Dim oFolder As Object
Dim oFile As Object
Dim sFile As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Set oFolder = fso.GetFolder(rFolder)
Set oFile = oFolder.Files
ReDim FileInfo(oFile.Count, 3)
For Each sFile In oFile
c2t = c2t + 1
If sFile.ParentFolder = rFolder And sFile.Type = "MP3 Format Sound" Or sFile.Type = "Windows Media Audio file" _
Or sFile.Type = "Wave Sound" Then 'check file attributes
FileInfo(c2t, 1) = sFile.Name
FileInfo(c2t, 2) = sFile.path
FileInfo(c2t, 3) = sFile.ParentFolder
End If
Next
GetFileInfo = FileInfo
End Function

Private Sub TreeView1_NodeClick(ByVal Node As MSComctlLib.Node)
If Node.Image = 1 Then
FillTreeDir (Node.Key) 'expand this level of the directory
End If
End Sub
 


mnik3,

Thanks for sharing your success.

Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top