DirListBox!!!! Where is in VBA????

[Gti]

Is there any VBA equivalent to VB's DirListbox,DrivesListBox, & FileListBox
in VBA?


Tkx

 

[Dzidze]

As you know, these are VB components. So you can use them in a VBA.
But, do you want them to do something specific?

 

[Aivars]

Hi!

Maybe functions what I made would help you?

Function ShowDriveList() As String
'This function return string for computer drives list (two columns)
On Error GoTo Err_ShowDriveList
Dim fs, D, dc, s, n
Dim dblFreeSpace As Double
Dim strFreeSpace As String

Set fs = CreateObject("Scripting.FileSystemObject&quot
Set dc = fs.Drives
For Each D In dc
If D.DriveType = 3 Then
n = D.ShareName
Else
n = D.VolumeName
End If
Select Case D.DriveType
Case 0: n = n & &quot; <Unknown> &quot;
Case 1: n = n & &quot; <Removable> &quot;
Case 2: n = n & &quot; <HDD> &quot;
Case 3: n = n & &quot; <Network>&quot;
Case 4: n = n & &quot; <CD-ROM> &quot;
Case 5: n = n & &quot; <RAM Disk> &quot;
End Select

If D.DriveType <> 3 Then
n = n & strFreeSpace & D.FileSystem & &quot; file system&quot;
End If

If Len(s) > 0 Then
s = s & &quot;;&quot;
End If
s = s & D.DriveLetter & &quot;;&quot;
s = s & D.DriveLetter & &quot;:\ - &quot;
s = s & n
Resume_ShowDriveList:

Next
ShowDriveList = s

Exit_ShowDriveList:
Exit Function

Err_ShowDriveList:
If Err.Number = 71 Then
Resume Resume_ShowDriveList
Else
MsgBox &quot;Error No &quot; & Err.Number & vbLf & vbLf & Error$
Resume Exit_ShowDriveList
End If
End Function
'-------------------------
Function ShowFolderList(FolderSpec As String) As String
'This function create text for folders listbox (one column)
Dim fs, f, f1, s, sf
Set fs = CreateObject(&quot;Scripting.FileSystemObject&quot
Set f = fs.GetFolder(FolderSpec)
Set sf = f.SubFolders
For Each f1 In sf
If s <> &quot;&quot; Then
s = s & &quot;;&quot;
End If
s = s & f1.Path
Next
ShowFolderList = s
End Function
'--------------------------
Function ListOfFileLocation(Optional strFileName As String = &quot;*.*&quot;, _
Optional strFolder As String = &quot;C:\&quot;, _
Optional blnSubFolders As Boolean = True, _
Optional intSortBy As Integer = 1, _
Optional intSortOrder As Integer = 1) As String

'strFileName --> File Name mask like &quot;DB*.mdb&quot;
'strFolder --> locations directory (e.g. &quot;C:\Temp\&quot;
'blnSubFolders --> Search In Sub Folders yes or no

'varSortBy --> The method used to sort the returned files
'msoSortByFileName = 1
'msoSortBySize = 2
'msoSortByFileType = 3
'msoSortByLastModified = 4

'varSortOrder --> The order in which the returned files are sorted
'msoSortOrderAscending = 1
'msoSortOrderDescending = 2

Dim strFileList As String
strFileName = Trim(strFileName)
If Right(strFolder, 1) <> &quot;\&quot; Then
strFolder = strFolder & &quot;\&quot;
End If
With Application.FileSearch
.LookIn = strFolder
.SearchSubFolders = blnSubFolders
If strFileName <> &quot;&quot; Then
.FileName = strFileName
Else
.FileType = msoFileTypeAllFiles
End If
If .Execute(intSortBy, intSortOrder) > 0 Then
For i = 1 To .FoundFiles.Count
'Compose list box row source clause
If strFileList <> &quot;&quot; Then
strFileList = strFileList & &quot;;&quot;
End If
'File Name; File Type; File Created;
'Last Modified; File Last Accessed; File Size
strFileList = strFileList & FileArgs(.FoundFiles(i))
Next i
Else
MsgBox &quot;File ''&quot; & strFileName & &quot;'' not found&quot;
End If
End With

ListOfFileLocation = strFileList
End Function
'-----------------------
Function FileArgs(FileSpec, Optional varDelimiter = &quot;;&quot
'This function return file properties list
'You can set other delimiter sush <VbLf> which equal chr(10)
'or <VbCrLf> which equal chr(10)+chr(13)
Dim fs, f, s
Set fs = CreateObject(&quot;Scripting.FileSystemObject&quot
Set f = fs.Getfile(FileSpec)
'File Name
s = FileSpec & varDelimiter
'File Type
s = s & f.Type & varDelimiter
'File Created
s = s & f.DateCreated & varDelimiter
'Last Modified
s = s & f.DateLastModified & varDelimiter
'File's Last Accessed
s = s & f.DateLastAccessed & varDelimiter
'File Size
s = s & f.Size

FileArgs = s
End Function

Aivars