1 Attachment(s)
VB6 - Enhance file listing, and cope with sub-dir's [resolved]
Hey everyone, well, i made this simple program to get all the files in a selected folder, and ten to search the 2nd level off folders in it, the porblem is most people will easily have more than two levels of folder to search within, how can i turn my example code into something that will deal with unlimited sub-dirs ?
My code :
VB Code:
Private Sub Form_Load()
Dim strStartPath As String
strStartPath = InputBox("Please enter start path", "Search Path", "C:\My Music")
ListFolder strStartPath
End Sub
Private Sub ListFolder(sFolderpath As String)
Dim FS As New FileSystemObject
Dim FSfolder As Folder
Dim subfolder As Folder
Set FSfolder = FS.GetFolder(sFolderpath)
For Each subfolder In FSfolder.SubFolders
DoEvents
Debug.Print subfolder
List1.AddItem subfolder
Next subfolder
Set FSfolder = Nothing
LoopList
End Sub
Private Function ListSubFolder(sFolderpath As String)
Dim FS As New FileSystemObject
Dim FSfolder As Folder
Dim subfolder As Folder
Set FSfolder = FS.GetFolder(sFolderpath)
For Each subfolder In FSfolder.SubFolders
DoEvents
Debug.Print subfolder
List2.AddItem subfolder
Next subfolder
Set FSfolder = Nothing
End Function
Private Function LoopList()
List1.ListIndex = 0
Do Until List1.ListIndex = List1.ListCount - 1
ListSubFolder List1.Text
List1.ListIndex = List1.ListIndex + 1
DoEvents
Loop
GetFiles
End Function
Private Function GetFiles()
List1.ListIndex = 0
List2.ListIndex = 0
Do Until List1.ListIndex = List1.ListCount - 1
ListFiles List1.Text
List1.ListIndex = List1.ListIndex + 1
DoEvents
Loop
Do Until List2.ListIndex = List2.ListCount - 1
ListFiles List2.Text
List2.ListIndex = List2.ListIndex + 1
DoEvents
Loop
End Function
Private Sub ListFiles(strPath As String, Optional Extention As String)
Dim File As String
If Right$(strPath, 1) <> "\" Then strPath = strPath & "\"
If Trim$(Extention) = "" Then
Extention = "*.*"
ElseIf Left$(Extention, 2) <> "*." Then
Extention = "*." & Extention
End If
File = Dir$(strPath & Extention)
Do While Len(File)
List3.AddItem strPath & File
File = Dir$
Loop
End Sub
Private Sub List3_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
CD.Filter = "Winamp Playlist(*.M3U)|*.M3U"
CD.ShowSave
Open CD.FileName For Output As #1
For i = 0 To List3.ListCount - 1
Print #1, List3.List(i)
Next
Close #1
End Sub
I will attach my project also.
Re: VB6 - Enhance file listing, and cope with sub-dir's
Well, there is a much easier way if you are interested :)
Have a look at this :)
Cheers,
RyanJ
Re: VB6 - Enhance file listing, and cope with sub-dir's
Quote:
Originally Posted by sciguyryan
Well, there is a much easier way if you are interested :)
Have a look at
this :)
Cheers,
RyanJ
Slight problem with that though, its for searching for a file in the Dir's and Sub dir's, i simply want to list the files...
Thanks for your input though.
Re: VB6 - Enhance file listing, and cope with sub-dir's
Quote:
Originally Posted by thegreatone
Slight problem with that though, its for searching for a file in the Dir's and Sub dir's, i simply want to list the files...
Thanks for your input though.
Oh, sorry... :blush:
How about one of these?
http://www.planet-source-code.com/vb...11311&lngWId=1
http://www.freevbcode.com/ShowCode.A...isting&ID=1331
Cheers,
RyanJ
1 Attachment(s)
Re: VB6 - Enhance file listing, and cope with sub-dir's
Hey Thanks, i tried repping you for your endeavours but i simply get
Quote:
Originally Posted by vBulleten Message
You must spread some Reputation around before giving it to sciguyryan again.
EDIT: I thought i'd attach my code, and probably my project files for File Grabber.
EDIT2 : Mayeb this could be posted in the Codebank for future reference ?
VB Code:
Function FolderContents(ByRef thePath As String, ByRef bolRecurseDirectories As Boolean, ByRef scratchfile As String)
Dim objFSO
Set objFSO = CreateObject("Scripting.FileSystemObject")
Dim objFolder
Set objFolder = objFSO.getFolder(thePath)
Call DisplayFolderContents(objFolder, bolRecurseDirectories, outFile)
Set objFolder = Nothing
Set objFSO = Nothing
End Function
Function DisplayFolderContents(objFolder, ByVal bolRecurseDirectories As Boolean, outFile)
Dim objFile, strPath, strExtension
For Each objFile In objFolder.Files
strPath = objFile.Path
List1.AddItem (objFile.Path)
Next
' Recurse subdirectories if necessary
Dim objSubFolder
If bolRecurseDirectories Then
For Each objSubFolder In objFolder.SubFolders
DisplayFolderContents objSubFolder, bolRecurseDirectories, outFile
Next
End If
LblCount.Caption = List1.ListCount
End Function
Private Sub Command1_Click()
Dim x As String
Dim y As Boolean
If Option1.Value = True Then y = True
If Option2.Value = True Then y = False
x = InputBox("Please enter start path", "Search Path", "C:\My Music")
FolderContents x, y, ""
End Sub
Private Sub Command2_Click()
List1.Clear
End Sub
Private Sub Command3_Click()
On Error GoTo saveerr
f = FreeFile
CD.Filter = "Text Files (*.txt)|*.txt"
CD.ShowSave
Open CD.FileName For Output As #f
For i = 0 To List1.ListCount - 1
Print #f, List1.List(i)
Next
Close #f
Exit Sub
saveerr:
If Err.Number <> 75 Then MsgBox Err.Number & ":" & Err.Description, vbCritical, "An Error has occurred"
End Sub
Private Sub Command4_Click()
On Error GoTo saveerr
f = FreeFile
Dim x As String
x = InputBox("Which file extension do you wish to save as ?" & vbCrLf & "File extensions should look like this *.ext when entered below" & vbCrLf & "For example a playlist would be *.m3u", "Input File Extension", "*.txt")
CD.Filter = x & "|" & x
CD.ShowSave
Open CD.FileName For Output As #f
For i = 0 To List1.ListCount - 1
Print #f, List1.List(i)
Next
Close #f
Exit Sub
saveerr:
If Err.Number <> 75 Then MsgBox Err.Number & ":" & Err.Description, vbCritical, "An Error has occurred"
End Sub
Re: VB6 - Enhance file listing, and cope with sub-dir's
Quote:
Originally Posted by
thegreatone
Hey Thanks, i tried repping you for your endeavours but i simply get
EDIT: I thought i'd attach my code, and probably my project files for File Grabber.
EDIT2 : Mayeb this could be posted in the Codebank for future reference ?
VB Code:
Function FolderContents(ByRef thePath As String, ByRef bolRecurseDirectories As Boolean, ByRef scratchfile As String)
Dim objFSO
Set objFSO = CreateObject("Scripting.FileSystemObject")
Dim objFolder
Set objFolder = objFSO.getFolder(thePath)
Call DisplayFolderContents(objFolder, bolRecurseDirectories, outFile)
Set objFolder = Nothing
Set objFSO = Nothing
End Function
Function DisplayFolderContents(objFolder, ByVal bolRecurseDirectories As Boolean, outFile)
Dim objFile, strPath, strExtension
For Each objFile In objFolder.Files
strPath = objFile.Path
List1.AddItem (objFile.Path)
Next
' Recurse subdirectories if necessary
Dim objSubFolder
If bolRecurseDirectories Then
For Each objSubFolder In objFolder.SubFolders
DisplayFolderContents objSubFolder, bolRecurseDirectories, outFile
Next
End If
LblCount.Caption = List1.ListCount
End Function
Private Sub Command1_Click()
Dim x As String
Dim y As Boolean
If Option1.Value = True Then y = True
If Option2.Value = True Then y = False
x = InputBox("Please enter start path", "Search Path", "C:\My Music")
FolderContents x, y, ""
End Sub
Private Sub Command2_Click()
List1.Clear
End Sub
Private Sub Command3_Click()
On Error GoTo saveerr
f = FreeFile
CD.Filter = "Text Files (*.txt)|*.txt"
CD.ShowSave
Open CD.FileName For Output As #f
For i = 0 To List1.ListCount - 1
Print #f, List1.List(i)
Next
Close #f
Exit Sub
saveerr:
If Err.Number <> 75 Then MsgBox Err.Number & ":" & Err.Description, vbCritical, "An Error has occurred"
End Sub
Private Sub Command4_Click()
On Error GoTo saveerr
f = FreeFile
Dim x As String
x = InputBox("Which file extension do you wish to save as ?" & vbCrLf & "File extensions should look like this *.ext when entered below" & vbCrLf & "For example a playlist would be *.m3u", "Input File Extension", "*.txt")
CD.Filter = x & "|" & x
CD.ShowSave
Open CD.FileName For Output As #f
For i = 0 To List1.ListCount - 1
Print #f, List1.List(i)
Next
Close #f
Exit Sub
saveerr:
If Err.Number <> 75 Then MsgBox Err.Number & ":" & Err.Description, vbCritical, "An Error has occurred"
End Sub
great code, however,how could you make it handle a greater map
e.g. "c:\"