PDA

View Full Version : [SOLVED] A challenge for someone



gibbo1715
08-31-2005, 11:17 AM
Below is some excellent code from xld to view a file structure including sub directories

Can anybody help me to get the results to display in a userform tree view and be able to open the file from there ( Is that even possible?)

I know this is a lot to ask of you but thought if i dont ask i definately dont get and to do this is definetly over my head at the moment!!!!!!

Gibbo


Option Explicit

Private cnt As Long
Private arfiles
Private level As Long

Sub Folders() Dim i As Long
Dim sFolder As String
Dim iStart As Long
Dim iEnd As Long
Dim fOutline As Boolean
arfiles = Array()
cnt = -1
level = 1
sFolder = "E:\"
ReDim arfiles(2, 0)
If sFolder <> "" Then
SelectFiles sFolder
Application.DisplayAlerts = False
On Error Resume Next
Worksheets("Files").Delete
On Error Goto 0
Application.DisplayAlerts = True
Worksheets.Add.Name = "Files"
With ActiveSheet
For i = LBound(arfiles, 2) To UBound(arfiles, 2)
If arfiles(0, i) = "" Then
If fOutline Then
Rows(iStart + 1 & ":" & iEnd).Rows.Group
End If
With .Cells(i + 1, arfiles(2, i))
.Value = arfiles(1, i)
.Font.Bold = True
End With
iStart = i + 1
iEnd = iStart
fOutline = False
Else
.Hyperlinks.Add Anchor:=.Cells(i + 1, arfiles(2, i)), _
Address:=arfiles(0, i), _
TextToDisplay:=arfiles(1, i)
iEnd = iEnd + 1
fOutline = True
End If
Next
.Columns("A:Z").ColumnWidth = 5
End With
End If
'just in case there is another set to group
If fOutline Then
Rows(iStart + 1 & ":" & iEnd).Rows.Group
End If
Columns("A:Z").ColumnWidth = 5
ActiveSheet.Outline.ShowLevels RowLevels:=1
ActiveWindow.DisplayGridlines = False
End Sub

Sub SelectFiles(Optional sPath As String)
Static FSO As Object
Dim oSubFolder As Object
Dim oFolder As Object
Dim oFile As Object
Dim oFiles As Object
Dim arPath
If FSO Is Nothing Then
Set FSO = CreateObject("Scripting.FileSystemObject")
End If
If sPath = "" Then
sPath = CurDir
End If
arPath = Split(sPath, "\")
cnt = cnt + 1
ReDim Preserve arfiles(2, cnt)
arfiles(0, cnt) = ""
arfiles(1, cnt) = arPath(level - 1)
arfiles(2, cnt) = level
Set oFolder = FSO.GetFolder(sPath)
Set oFiles = oFolder.Files
For Each oFile In oFiles
cnt = cnt + 1
ReDim Preserve arfiles(2, cnt)
arfiles(0, cnt) = oFolder.Path & "\" & oFile.Name
arfiles(1, cnt) = oFile.Name
arfiles(2, cnt) = level + 1
Next oFile
level = level + 1
For Each oSubFolder In oFolder.Subfolders
SelectFiles oSubFolder.Path
Next
level = level - 1
End Sub


#If VBA6 Then
#Else

Function Split(Text As String, _
Optional Delimiter As String = ",") As Variant
Dim i As Long
Dim sFormula As String
Dim aryEval
Dim aryValues
If Delimiter = vbNullChar Then
Delimiter = Chr(7)
Text = Replace(Text, vbNullChar, Delimiter)
End If
sFormula = "{""" & Application.Substitute(Text, Delimiter, """,""") & """}"
aryEval = Evaluate(sFormula)
ReDim aryValues(0 To UBound(aryEval) - 1)
For i = 0 To UBound(aryValues)
aryValues(i) = aryEval(i + 1)
Next
Split = aryValues
End Function

Public Function InStrRev(stringcheck As String, _
ByVal stringmatch As String, _
Optional ByVal start As Long = -1)
Dim iStart As Long
Dim iLen As Long
Dim i As Long
If iStart = -1 Then
iStart = Len(stringcheck)
Else
iStart = start
End If
iLen = Len(stringmatch)
For i = iStart To 1 Step -1
If Mid(stringcheck, i, iLen) = stringmatch Then
InStrRev = i
Exit Function
End If
Next i
InStrRev = 0
End Function

#End If

MWE
08-31-2005, 11:34 AM
If I understand you correctly, Application.GetOpenFileName should do what you want. This will display a standard folder/files window, allow the user to navigate and select a file and then pass the filename back to the calling application. Opening it is then easy.

gibbo1715
08-31-2005, 11:38 AM
I am going to expand on the code to allow my users to search all files within a directory they choose for a key word, was interested in learning if displaying the results a s a treeview on a userform was possible?

ALe
09-01-2005, 01:43 AM
I think this is what you're looking for.

Get the control "Microsoft Tree View 6.0" (or 5.0 depending of your excel version) and put it in a userform.

Fill the object TreeView with your file names using the "nodes.add"

here an example you can easily use

1. Make the reference to microsoft scripting
2. Put a treeView Control in an userform
3. Paste this code in the module of the userform



Option Explicit

Private Sub TreeViewPopulate(sPath As String)
Dim fso As FileSystemObject
Dim fld As Folder
Set fso = New Scripting.FileSystemObject
If fso.FolderExists(sPath) Then
TreeView1.Nodes.Clear
Set fld = fso.GetFolder(sPath)
Call GetFiles(fld)
Else
MsgBox "The folder path " & sPath & "does not exist"
End If
End Sub

Private Sub GetFiles(fld As Folder, Optional metro As Folder = Null)
Dim son As Folder
Dim fil As File
Dim nod As Node
On Error Resume Next
If metro Is Nothing Then
Set nod = TreeView1.Nodes.Add(, , fld.Name, fld.Name)
nod.Expanded = True
Else
TreeView1.Nodes.Add metro.Name, tvwChild, fld.Name, fld.Name
End If
Application.StatusBar = "Filling nodes for " & fld.Path
For Each son In fld.SubFolders
Call GetFiles(son, fld)
Next
For Each fil In fld.Files
TreeView1.Nodes.Add fld.Name, tvwChild, fil.Path, fil.Name
Next
End Sub

Private Sub UserForm_activate()
Call TreeViewPopulate("C:\Documents and Settings\")
Application.StatusBar = ""
End Sub

Private Sub UserForm_Initialize()
With TreeView1
.Appearance = cc3D
.Indentation = 12
End With
End Sub

Hope it's what you're looking for.

gibbo1715
09-01-2005, 02:28 AM
That is real cool, I am very impressed

Another question

Is there an easy way to make it so i can open the item I select in the treeview?

what im trying to end up with is a key word search that will search the directory and then bring back a treeview displaying the files within that directory that contain the word im looking for and then allow me to open it from my user form

ALe
09-01-2005, 02:49 AM
use this to get the name of the file



Private Sub TreeView1_Click()
MsgBox TreeView1.SelectedItem
End Sub

ALe
09-01-2005, 02:55 AM
the procedure writes the name of the file as text in the treeView nodes. That means that you don't have the fullpath of the file selected in the treeView. In other words, if you want to open the file from the treeView you have to get again the fullpath of the file.

ALe
09-01-2005, 02:57 AM
Oooops! sorry for some italian word used for the variables in the procedure i sent you.

ALe
09-01-2005, 03:12 AM
Another way is to insert the fullpath string of the folders in the procedure while it is running.

You can do this setting the tag of nodes and items to their paths.

In this case, if your start folder contains lots of subfolders and files, the procedure could go slower.

johnske
09-01-2005, 03:18 AM
Hi gibbo,

I don't know whether this (http://www.vbaexpress.com/forum/showthread.php?t=1714&highlight=tree+view) thread is of any use to you or if it does what you want, but it wouldn't hurt to check it out (this one (http://www.vbaexpress.com/forum/showthread.php?t=1676&highlight=tree+view) too) :hi:

HTH,
John :thumb

gibbo1715
09-01-2005, 07:00 AM
Thanks all for the replies, this i feel is a little over my head at the moment but im gonna keep trying (with your continued patience and help).

Im curious about how i set the tag of the nodes though as described by ALe

Another way is to insert the fullpath string of the folders in the procedure while it is running.

You can do this setting the tag of nodes and items to their paths.

In this case, if your start folder contains lots of subfolders and files, the procedure could go slower.


Also then ignoring the how to open the file issue at the moment, how can i search the files in a dir (and sub dir) for a key word and then display the results in a tree view showing the file paths for files containing a keyword (same format as the above does?)

Im sure someone will tell me it is possible but im at a loss at the moment

Cheers

Gibbo

ALe
09-01-2005, 08:18 AM
Here the code regarding:
- tag issue
- getting the fullpath of files/folders
- searching for a key word

insert a textbox and a listbox under the treeview and paste this code in the form module


Option Explicit
Public MySearch As String
Private Sub TreeViewPopulate(sPath As String)
Dim fso As FileSystemObject
Dim fld As Folder
Set fso = New Scripting.FileSystemObject
If fso.FolderExists(sPath) Then
TreeView1.Nodes.Clear
Set fld = fso.GetFolder(sPath)
'MsgBox fld.Path
Call GetFiles(fld)
Else
MsgBox "The folder path " & sPath & "does not exist"
End If
End Sub
Private Sub GetFiles(fld As Folder, Optional metro As Folder = Null)
Dim son As Folder
Dim fil As File
Dim nod As Node
On Error Resume Next
If metro Is Nothing Then
Set nod = TreeView1.Nodes.Add(, , fld.Name, fld.Name)
nod.Tag = fld
nod.Expanded = True
Else
TreeView1.Nodes.Add metro.Name, tvwChild, fld.Name, fld.Name
TreeView1.Nodes(fld.Name).Tag = fld.Path
End If
Application.StatusBar = "Filling nodes for " & fld.Path
For Each son In fld.SubFolders
Call GetFiles(son, fld)
Next
For Each fil In fld.Files
TreeView1.Nodes.Add fld.Name, tvwChild, fil.Path, fil.Name
TreeView1.Nodes(fil.Path).Tag = fil.Path
Next
End Sub
Private Sub TreeView1_Click()
On Error Resume Next 'in case you select an item that is not a folder or a file
Me.TextBox1.Text = TreeView1.SelectedItem.Tag
End Sub
Private Sub UserForm_activate()
Call TreeViewPopulate("C:\Documents and Settings\aboffi\Desktop\Nuova Cartella\")
Application.StatusBar = ""
Call search
End Sub
Private Sub UserForm_Initialize()
With TreeView1
.Appearance = cc3D
.Indentation = 12
End With
End Sub
Sub search()
Me.ListBox1.Clear
MySearch = "setup" 'this is the keyword (LookOut! It's case sensitive)
Dim nod As Node
For Each nod In Me.TreeView1.Nodes
If InStr(1, nod.Tag, MySearch) > 0 Then
Me.ListBox1.AddItem nod.Tag
End If
Next nod
End Sub


Having the path, you can open the files.

ALe
09-01-2005, 08:21 AM
of course you have to pass the key word to the procedure "Search". In my example it is inside this procedure and it set = setup.

gibbo1715
09-01-2005, 12:16 PM
that worked great until my pc crashed Doh!!!

one question, looking at it am i right in thinking it key word searches the file name, not the content of the file,

i need to be able to search with in the files for the keyword, is that possible?

ALe
09-02-2005, 12:47 AM
Yes it is possible. Of course it's a complex work (and the procedure could be very very slow). As far as I know you should open each file (without making it visible) and search in it.

For example if it is a word file you must use "find.text".
There must be also the possibility to use the search utility of windows, but actually i'm not sure about it and I can't help you a lot on this.

gibbo1715
09-02-2005, 01:13 AM
Thanks for taking the time to look

I ve tried the below (Not completed) to search individual files and sub directories but its a bit flaky on excel 2000 with win xp


Sub Button1_Click()
Dim sFollder As String
sFollder = GetFolderPath
If sFollder <> vbNullString Then MsgBox sFollder
End Sub

Function GetFolderPath() As String
Dim oShell As Object
Set oShell = CreateObject("Shell.Application"). _
BrowseForFolder(0, "Please select folder", 0, "c:\\")
If Not oShell Is Nothing Then
GetFolderPath = oShell.Items.Item.Path
Else
GetFolderPath = vbNullString
End If
Set oShell = Nothing
End Function

Sub FindTextString()
Dim i As Integer
Dim szSearchWord As Variant
Dim ThisPath As String
Dim ThisName As String
Dim Savename As String
Dim sFollder As String
sFollder = GetFolderPath
If sFollder <> vbNullString Then MsgBox sFollder
ThisPath = ThisWorkbook.Path
ThisName = ThisWorkbook.Name
Savename = ThisPath & "\" & ThisName
szSearchWord = sFollder 'Application.InputBox("What are you looking for ?", "Search", , 100, 100, , , 2)
If szSearchWord = False Then
Sheets("Sheet1").Select
End
End If
With Application.FileSearch
.NewSearch
.LookIn = ThisWorkbook.Path
.FileType = msoFileTypeAllFiles
.SearchSubFolders = True
.TextOrProperty = szSearchWord
.Execute
MsgBox "There were " & .FoundFiles.Count & " file(s) found."
For i = 1 To .FoundFiles.Count
ActiveSheet.Range("b" & (i + 1)) = .FoundFiles(i) 'FoundFiles(i) 'Mid(.FoundFiles(i), InStrRev(.FoundFiles(i), "\") + 1)
Next i
End With
SaveAs Savename
Exit Sub
End Sub

It stores the data onto an excel spreadsheet that i can then pull into a listbox ( or tree view i guess although i dont know how). Can you help with that ALe?

Also Using a variation of your code is it possible to set up a treeview on a userform that will have the top level being column A then move across to Column b ,c ,d etc if they contain data?

ALe
09-02-2005, 03:16 AM
Have a look http://www.vbaexpress.com/forum/showthread.php?t=1714&highlight=tree+view

ALe
09-02-2005, 03:28 AM
If your problem is to store the data in the list box, insert the listbox1 in your sheet and use this at the bottom of the procedure instead of what you wrote:



For i = 1 To .FoundFiles.Count
ActiveSheet.Range("b" & (i + 1)) = .FoundFiles(i)
worksheets(1).listbox1.additem .foundfiles(i)
Next i

gibbo1715
09-02-2005, 04:34 AM
Thanks for the reply ALe
Im ok with using a listbox to display my hits, have a look at the attached example ( ive used a userform as i prefer that method and thought others might find this useful)

I can now populate a treeview as well but my problem is my search data is currently returned into one cell per hit (e.g. c:\docs\other\file 1) when i want a treeview structure as below

c:\ - docs - file 1
file 2
other - file1
file2
another - file 1
d:\ - sheets - sheet1

Any ideas? and thanks for the help so far, has been really helpful already

Cheers

Gibbo

ALe
09-02-2005, 07:34 AM
This must be what you wanted.

Here your file with the code you're looking for.
I highlighted my code and I didn't change yours so that you can go on with your job easily.

You don't need to write the file names on the sheet.

gibbo1715
09-02-2005, 07:59 AM
Thats pretty cool, and was where i was trying to get, have you considered making this a kb entry as i am sure others would benifit from this as much as I have.

One final question ( I think;) )

I can use MsgBox TreeView1.SelectedItem to show the item selected, is there a way of showing the parent nodes (If there are any) as well?

ALe
09-02-2005, 08:10 AM
that's very easy. Set the parent variable (you find it in the code) as the tag of each nodes (do it before you update the variable with the new node). Then you can get the parents names using their tags.

About the entry, I agree with you. But first code must be cleared. I'm going to do it next days.
I will record you and me as the authors.

ALe
09-02-2005, 08:18 AM
Of course if you need the path of all the parent folders, create a string that is the sum of all the parent variable you have while macro is running.

gibbo1715
09-02-2005, 09:10 AM
that's very easy. Set the parent variable (you find it in the code) as the tag of each nodes (do it before you update the variable with the new node). Then you can get the parents names using their tags.


Easy when you know how, but you ll have to explain to me in more detail please

Cheers

Gibbo

gibbo1715
09-03-2005, 02:02 AM
Anyone?

ALe
09-05-2005, 12:29 AM
Ok, first you'll explain it to me. Do you need, for any node, a list of all the parent folders or the path of the parent folder?

ALe
09-05-2005, 12:44 AM
try this:



Private Sub TreeView1_Click()
On Error Resume Next 'selection is not a node
MsgBox "The parent folder of " & TreeView1.SelectedItem.Text & " is " _
& TreeView1.SelectedItem.parent.Text
End Sub

gibbo1715
09-05-2005, 01:06 AM
Thanks ALe, i wont be able to try it till this evening but im sure it will do what im after

Cheers

Gibbo

ALe
09-05-2005, 01:09 AM
Ok, let me know

gibbo1715
09-05-2005, 09:38 AM
ALi, i need the full path not just the parent folder if thats possible?

ALe
09-06-2005, 03:31 AM
Here your code, finally.


Function GetFolderPath() As String
Dim oShell As Object
Set oShell = CreateObject("Shell.Application"). _
BrowseForFolder(0, "Please select folder", 0, "c:\\")
If Not oShell Is Nothing Then
GetFolderPath = oShell.Items.Item.Path
Else
GetFolderPath = vbNullString
End If
Set oShell = Nothing
End Function

Sub FindTextString()
Dim i As Integer
Dim szSearchWord As Variant
Dim ThisPath As String
Dim ThisName As String
Dim Savename As String
Dim sFollder As String
Dim NodeFullPath As String
sFollder = GetFolderPath
If sFollder <> vbNullString Then MsgBox sFollder
ThisPath = ThisWorkbook.Path
ThisName = ThisWorkbook.Name
Savename = ThisPath & "\" & ThisName
szSearchWord = Application.InputBox("What are you looking for ?", "Search", , 100, 100, , , 2)
If szSearchWord = False Then
Sheets("Sheet1").Select
End
End If
With Application.FileSearch
.NewSearch
.LookIn = sFollder
.FileType = msoFileTypeAllFiles
.SearchSubFolders = True
.TextOrProperty = szSearchWord
.Execute
MsgBox "There were " & .FoundFiles.Count & " file(s) found."
For i = 1 To .FoundFiles.Count
ActiveSheet.Range("b" & (i + 1)) = .FoundFiles(i)
Next i
End With
Dim nod As Node
Dim MyPath, NodeName, parent As String
Dim n, k As Integer
For i = 1 To Application.FileSearch.FoundFiles.Count
k = 0
MyPath = Application.FileSearch.FoundFiles(i)
NodeFullPath = ""
Do Until InStr(1, MyPath, "\") = 0 And InStr(1, MyPath, ".") = 0
k = k + 1
If InStr(1, MyPath, "\") <> 0 Then
n = InStr(1, MyPath, "\")
NodeName = Mid(MyPath, 1, n)
MyPath = Mid(MyPath, n + 1, 500)
NodeFullPath = NodeFullPath & NodeName
Else
NodeName = MyPath
NodeFullPath = NodeFullPath & MyPath
MyPath = ""
End If
'On Error GoTo Riprendi
'populateTV
With Me.TreeView1
If k = 1 Then
On Error Resume Next 'nod already existing
Set nod = TreeView1.Nodes.Add(, , NodeName, NodeName)
.Nodes(NodeName).Tag = NodeFullPath
Else
On Error Resume Next 'nod already existing
.Nodes.Add parent, tvwChild, NodeName, NodeName
If .Nodes(NodeName).Tag = "" Then .Nodes(NodeName).Tag = NodeFullPath
End If
Err.Clear
End With
FineEnd:
parent = NodeName
Loop
Next i
For Each nod In Me.TreeView1.Nodes
nod.EnsureVisible
Next nod
'SaveAs Savename
Exit Sub
Riprendi:
Err.Clear
GoTo FineEnd
End Sub

Private Sub CommandButton1_Click()
Call FindTextString
End Sub

Private Sub TreeView1_Click()
On Error Resume Next 'selection is not a node
MsgBox "The full path of " & TreeView1.SelectedItem.Text & " is: " & TreeView1.SelectedItem.Tag
End Sub

gibbo1715
09-06-2005, 04:34 AM
That was perfect

Cheers

Gibbo

ALe
09-06-2005, 05:20 AM
Ok. Of course now the code has some lines useless. Remove them if you want to speed up the procedure.

Bye, ALe

gibbo1715
09-06-2005, 05:51 AM
Thanks ALe

Can i remove more from this code than I have now then?


Sub FindTextString()
Dim i As Integer
Dim szSearchWord As Variant
Dim sFollder As String
Dim nod As Node
Dim MyPath, NodeName, parent As String
Dim n, k As Integer
Dim NodeFullPath As String
sFollder = GetFolderPath
If sFollder <> vbNullString Then MsgBox sFollder
szSearchWord = Application.InputBox("What are you looking for ?", "Search", , 100, 100, , , 2)
If szSearchWord = False Then
Sheets("Sheet1").Select
End
End If
With Application.FileSearch
.NewSearch
.LookIn = sFollder
.FileType = msoFileTypeAllFiles
.SearchSubFolders = True
.TextOrProperty = szSearchWord
.Execute
' MsgBox "There were " & .FoundFiles.Count & " file(s) found."
End With
For i = 1 To Application.FileSearch.FoundFiles.Count
k = 0
MyPath = Application.FileSearch.FoundFiles(i)
NodeFullPath = ""
Do Until InStr(1, MyPath, "\") = 0 And InStr(1, MyPath, ".") = 0
k = k + 1
If InStr(1, MyPath, "\") <> 0 Then
n = InStr(1, MyPath, "\")
NodeName = Mid(MyPath, 1, n)
MyPath = Mid(MyPath, n + 1, 500)
NodeFullPath = NodeFullPath & NodeName
Else
NodeName = MyPath
NodeFullPath = NodeFullPath & MyPath
MyPath = ""
End If
'On Error GoTo Riprendi
'populateTV
With Me.TreeView1
If k = 1 Then
On Error Resume Next 'nod already existing
Set nod = TreeView1.Nodes.Add(, , NodeName, NodeName)
.Nodes(NodeName).Tag = NodeFullPath
Else
On Error Resume Next 'nod already existing
.Nodes.Add parent, tvwChild, NodeName, NodeName
If .Nodes(NodeName).Tag = "" Then .Nodes(NodeName).Tag = NodeFullPath
End If
Err.Clear
End With
FineEnd:
parent = NodeName
Loop
Next i
For Each nod In Me.TreeView1.Nodes
nod.EnsureVisible
Next nod
'SaveAs Savename
Exit Sub
Riprendi:
Err.Clear
Goto FineEnd
End Sub

Cheers

Gibbo