vbkann
asked on
Directory and file listing
Can someone please help me with some code.
I want to be able to put the contents of a drive or folder into 2 string variables, one with each filename and the other with the folders.
The values need to be separated by a ","
(no quotes) and preferably in alphabetical order.
Please supply some code...thanks.
And no. i do not want to use any controls to do this.
I want to be able to put the contents of a drive or folder into 2 string variables, one with each filename and the other with the folders.
The values need to be separated by a ","
(no quotes) and preferably in alphabetical order.
Please supply some code...thanks.
And no. i do not want to use any controls to do this.
Try this code..
Dim Dirs() As String
Dim Files() As String
Dim a As Long
Dim sFiles As String
Dim sDirs As String
Call clsFile.ListContent("E:\Mp 3\", Dirs, Files, True)
For a = 1 To UBound(Files)
sFiles = sFiles & Files(a) & ","
Next
For a = 1 To UBound(Dirs)
sDirs = sDirs & Dirs(a) & ","
Next
... using this function..
Function ListContent(ByVal Path As String, ByRef Dirs() As String, ByRef Files() As String, Recursive As Boolean, Optional ByRef DirCount As Long, Optional ByRef Filecount As Long, Optional StartDir As Boolean = True, Optional IncludePaths As Boolean = True)
Dim MyName As String
Dim MyDir() As String
Dim MyDirNr As Integer
Dim a As Integer
MyDirNr = 0
ReDim MyDir(0)
If StartDir Then
ReDim Dirs(0)
ReDim Files(0)
Path = IIf(Right$(Path, 1) = "\", "", "\")
End If
On Error GoTo Errorhandler
MyName = Dir$(Path + "*", vbDirectory + vbArchive + vbHidden + vbReadOnly + vbSystem)
Do While (MyName <> "")
If (MyName <> ".") And (MyName <> "..") Then
If ((GetAttr(Path & MyName) And vbDirectory) <> vbDirectory) Then
If (Filecount Mod 100 = 0) Then ReDim Preserve Files(Filecount + 100)
Filecount = Filecount + 1
If IncludePaths Then
Files(Filecount) = Path + MyName
Else
Files(Filecount) = MyName
End If
Else
If (DirCount Mod 100 = 0) Then ReDim Preserve Dirs(DirCount + 100)
DirCount = DirCount + 1
If IncludePaths Then
Dirs(DirCount) = Path + MyName
Else
Dirs(DirCount) = MyName
End If
ReDim Preserve MyDir(UBound(MyDir) + 1)
MyDirNr = MyDirNr + 1
MyDir(MyDirNr) = MyName
End If
End If
MyName = Dir
Loop
If Recursive Then
For a = 1 To MyDirNr
If Not ListContent(Path + MyDir(a) + "\", Dirs, Files, True, DirCount, Filecount, False, IncludePaths) Then GoTo Errorhandler
Next
End If
If StartDir Then
ReDim Preserve Files(Filecount)
ReDim Preserve Dirs(DirCount)
End If
ListContent = True
Exit Function
Errorhandler:
ListContent = False
End Function
Dim Dirs() As String
Dim Files() As String
Dim a As Long
Dim sFiles As String
Dim sDirs As String
Call clsFile.ListContent("E:\Mp
For a = 1 To UBound(Files)
sFiles = sFiles & Files(a) & ","
Next
For a = 1 To UBound(Dirs)
sDirs = sDirs & Dirs(a) & ","
Next
... using this function..
Function ListContent(ByVal Path As String, ByRef Dirs() As String, ByRef Files() As String, Recursive As Boolean, Optional ByRef DirCount As Long, Optional ByRef Filecount As Long, Optional StartDir As Boolean = True, Optional IncludePaths As Boolean = True)
Dim MyName As String
Dim MyDir() As String
Dim MyDirNr As Integer
Dim a As Integer
MyDirNr = 0
ReDim MyDir(0)
If StartDir Then
ReDim Dirs(0)
ReDim Files(0)
Path = IIf(Right$(Path, 1) = "\", "", "\")
End If
On Error GoTo Errorhandler
MyName = Dir$(Path + "*", vbDirectory + vbArchive + vbHidden + vbReadOnly + vbSystem)
Do While (MyName <> "")
If (MyName <> ".") And (MyName <> "..") Then
If ((GetAttr(Path & MyName) And vbDirectory) <> vbDirectory) Then
If (Filecount Mod 100 = 0) Then ReDim Preserve Files(Filecount + 100)
Filecount = Filecount + 1
If IncludePaths Then
Files(Filecount) = Path + MyName
Else
Files(Filecount) = MyName
End If
Else
If (DirCount Mod 100 = 0) Then ReDim Preserve Dirs(DirCount + 100)
DirCount = DirCount + 1
If IncludePaths Then
Dirs(DirCount) = Path + MyName
Else
Dirs(DirCount) = MyName
End If
ReDim Preserve MyDir(UBound(MyDir) + 1)
MyDirNr = MyDirNr + 1
MyDir(MyDirNr) = MyName
End If
End If
MyName = Dir
Loop
If Recursive Then
For a = 1 To MyDirNr
If Not ListContent(Path + MyDir(a) + "\", Dirs, Files, True, DirCount, Filecount, False, IncludePaths) Then GoTo Errorhandler
Next
End If
If StartDir Then
ReDim Preserve Files(Filecount)
ReDim Preserve Dirs(DirCount)
End If
ListContent = True
Exit Function
Errorhandler:
ListContent = False
End Function
Sorted:
Option Explicit
Private Function GetDirs(sPath As String, FileOrDir As Integer) As String
Dim sName As String
Dim temp As String
Dim i As Integer
Dim sFullList() As String
ReDim sFullList(0)
sPath = "c:\" 'Set the path.
sName = Dir(sPath, FileOrDir) ' Get first directory
Do While sName <> vbNullString ' Start looping
' Ignore the current directory and the encompassing directory.
If sName <> "." And sName <> ".." Then
If (GetAttr(sPath & sName) And FileOrDir) = FileOrDir Then
sFullList(i) = sName
ReDim Preserve sFullList(UBound(sFullList ) + 1)
i = i + 1
End If
End If
sName = Dir 'Get next
Loop
QuickSort sFullList, 0, UBound(sFullList)
For i = 0 To UBound(sFullList)
If Not sFullList(i) = vbNullString Then
temp = temp & sFullList(i)
If i < UBound(sFullList) Then
temp = temp & ","
End If
End If
Next
GetDirs = temp
End Function
Private Sub Command1_Click()
Text1.Text = GetDirs("c:\", vbDirectory) 'list direcories
Text2.Text = GetDirs("c:\", vbNormal) 'list files
End Sub
' ========================== == QuickSort ========================== ==
' QuickSort works by picking a random "pivot" element in SortArray,
' then moving every element that is bigger to one side of the pivot,
' & every element that is smaller to the other side. QuickSort is
' then called recursively with the two subdivisions created by the
' pivot. Once the number of elements in a subdivision reaches two,
' the recursive calls end and the array is sorted.
' ========================== ========== ========== ========== ========== =
'
Private Sub QuickSort(SortArray() As String, ByVal Low As Long, _
ByVal High As Long)
Dim i As Long, J As Long, RandIndex As Long, Partition As String
If Low < High Then
' Only two elements in this subdivision; swap them if they are
' out of order, then end recursive calls:
If High - Low = 1 Then
If UCase(SortArray(Low)) > UCase(SortArray(High)) Then
SWAP SortArray(Low), SortArray(High)
End If
Else
' Pick a pivot element at random, then move it to the end:
RandIndex = Rnd() * (High - Low) + Low ' RandInt%(Low, High)
SWAP SortArray(High), SortArray(RandIndex)
Partition = UCase(SortArray(High))
Do
' Move in from both sides towards the pivot element:
i = Low: J = High
Do While (i < J) And (UCase(SortArray(i)) <= Partition)
i = i + 1
Loop
Do While (J > i) And (UCase(SortArray(J)) >= Partition)
J = J - 1
Loop
' If we haven't reached the pivot element it means that 2
' elements on either side are out of order, so swap them:
If i < J Then
SWAP SortArray(i), SortArray(J)
End If
Loop While i < J
' Move the pivot element to its proper place in the array:
SWAP SortArray(i), SortArray(High)
' Recursively call the QuickSort procedure (pass the
' smaller subdivision first to use less stack space):
If (i - Low) < (High - i) Then
QuickSort SortArray, Low, i - 1
QuickSort SortArray, i + 1, High
Else
QuickSort SortArray, i + 1, High
QuickSort SortArray, Low, i - 1
End If
End If
End If
End Sub
Private Sub SWAP(first As String, second As String)
Dim temp As String
temp = first
first = second
second = temp
End Sub
Option Explicit
Private Function GetDirs(sPath As String, FileOrDir As Integer) As String
Dim sName As String
Dim temp As String
Dim i As Integer
Dim sFullList() As String
ReDim sFullList(0)
sPath = "c:\" 'Set the path.
sName = Dir(sPath, FileOrDir) ' Get first directory
Do While sName <> vbNullString ' Start looping
' Ignore the current directory and the encompassing directory.
If sName <> "." And sName <> ".." Then
If (GetAttr(sPath & sName) And FileOrDir) = FileOrDir Then
sFullList(i) = sName
ReDim Preserve sFullList(UBound(sFullList
i = i + 1
End If
End If
sName = Dir 'Get next
Loop
QuickSort sFullList, 0, UBound(sFullList)
For i = 0 To UBound(sFullList)
If Not sFullList(i) = vbNullString Then
temp = temp & sFullList(i)
If i < UBound(sFullList) Then
temp = temp & ","
End If
End If
Next
GetDirs = temp
End Function
Private Sub Command1_Click()
Text1.Text = GetDirs("c:\", vbDirectory) 'list direcories
Text2.Text = GetDirs("c:\", vbNormal) 'list files
End Sub
' ==========================
' QuickSort works by picking a random "pivot" element in SortArray,
' then moving every element that is bigger to one side of the pivot,
' & every element that is smaller to the other side. QuickSort is
' then called recursively with the two subdivisions created by the
' pivot. Once the number of elements in a subdivision reaches two,
' the recursive calls end and the array is sorted.
' ==========================
'
Private Sub QuickSort(SortArray() As String, ByVal Low As Long, _
ByVal High As Long)
Dim i As Long, J As Long, RandIndex As Long, Partition As String
If Low < High Then
' Only two elements in this subdivision; swap them if they are
' out of order, then end recursive calls:
If High - Low = 1 Then
If UCase(SortArray(Low)) > UCase(SortArray(High)) Then
SWAP SortArray(Low), SortArray(High)
End If
Else
' Pick a pivot element at random, then move it to the end:
RandIndex = Rnd() * (High - Low) + Low ' RandInt%(Low, High)
SWAP SortArray(High), SortArray(RandIndex)
Partition = UCase(SortArray(High))
Do
' Move in from both sides towards the pivot element:
i = Low: J = High
Do While (i < J) And (UCase(SortArray(i)) <= Partition)
i = i + 1
Loop
Do While (J > i) And (UCase(SortArray(J)) >= Partition)
J = J - 1
Loop
' If we haven't reached the pivot element it means that 2
' elements on either side are out of order, so swap them:
If i < J Then
SWAP SortArray(i), SortArray(J)
End If
Loop While i < J
' Move the pivot element to its proper place in the array:
SWAP SortArray(i), SortArray(High)
' Recursively call the QuickSort procedure (pass the
' smaller subdivision first to use less stack space):
If (i - Low) < (High - i) Then
QuickSort SortArray, Low, i - 1
QuickSort SortArray, i + 1, High
Else
QuickSort SortArray, i + 1, High
QuickSort SortArray, Low, i - 1
End If
End If
End If
End Sub
Private Sub SWAP(first As String, second As String)
Dim temp As String
temp = first
first = second
second = temp
End Sub
ASKER
eric37..this is perfect..if you could please modify it so that i can view all files...(hidden etc) and not just the normal files...
thanks
thanks
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
thank you vey much
ASKER
wait a moment....how can i view the listings of other folders..and not just the root directory..
it doesnt work.
can you please modify the code to let me get listings of other folders....thanks
it doesnt work.
can you please modify the code to let me get listings of other folders....thanks
Try the code I posted, it works for recursive listing.
ASKER
I have tried your code and it is very slow.
Im sorry but i would rather use eric37's code as it is fast, if only it could do other folders. Can you please help me to be able to do this..thank you
Im sorry but i would rather use eric37's code as it is fast, if only it could do other folders. Can you please help me to be able to do this..thank you
The code is fast because it only returns top level directories for any given path. If you recurse into all subdirectories, any coding will slow down.
ASKER
But cant i just get a listing of all the directories and files in a path that i specify.
Just in that path.
I dont want to look into all subdirectories, i just want the files and directories in a given path, no subdirectories of those directories.
Can you explain to me how to do this....
cheers
Just in that path.
I dont want to look into all subdirectories, i just want the files and directories in a given path, no subdirectories of those directories.
Can you explain to me how to do this....
cheers
ASKER
But cant i just get a listing of all the directories and files in a path that i specify.
Just in that path.
I dont want to look into all subdirectories, i just want the files and directories in a given path, no subdirectories of those directories.
Can you explain to me how to do this....
cheers
Just in that path.
I dont want to look into all subdirectories, i just want the files and directories in a given path, no subdirectories of those directories.
Can you explain to me how to do this....
cheers
Gotta ask, you mean my code looked slow or did it take a longer time to process than erick's? <g>
I don't felt like optimizing the code, since I felt that someone that wanted to get all filenames/dirnames into one big string, can't be thinking about performance. ;)
I don't felt like optimizing the code, since I felt that someone that wanted to get all filenames/dirnames into one big string, can't be thinking about performance. ;)
Yes there is a bug...
Get rid of the line
sPath = "c:\" 'Set the path.
in the function!
And if you want to view the contents of the windows directory call:
Private Sub Command1_Click()
Text1.Text = GetDirs("c:\windows\", vbDirectory) 'list direcories
Text2.Text = GetDirs("c:\windows\", vbNormal) 'list files
End Sub
Get rid of the line
sPath = "c:\" 'Set the path.
in the function!
And if you want to view the contents of the windows directory call:
Private Sub Command1_Click()
Text1.Text = GetDirs("c:\windows\", vbDirectory) 'list direcories
Text2.Text = GetDirs("c:\windows\", vbNormal) 'list files
End Sub
Private Function GetDirs(sPath As String, FileOrDir As Integer) As String
Dim sName As String
Dim sFullList As String
sPath = "c:\" 'Set the path.
sName = Dir(sPath, FileOrDir) ' Get first directory
Do While sName <> vbNullString ' Start looping
' Ignore the current directory and the encompassing directory.
If sName <> "." And sName <> ".." Then
If (GetAttr(sPath & sName) And FileOrDir) = FileOrDir Then
sFullList = sFullList & sName & "," 'Make the string
End If
End If
sName = Dir 'Get next
Loop
sFullList = Left(sFullList, Len(sFullList) - 1) 'strip last ","
GetDirs = sFullList
End Function
Private Sub Command1_Click()
Text1.Text = GetDirs("c:\", vbDirectory) 'list direcories
Text2.Text = GetDirs("c:\", vbNormal) 'list files
End Sub