The following code will loop through all the files and folders in a directory. Before you copy the code add the controls below to a form named frmExample, and add a module.
Controls:
| Control Type | Control Name |
| ListBox | lstFolders |
| ListBox | lstFiles |
| TextBox | txtFolder |
| CommandButton | cmdList |
| CommandButton | cmdGo |
Form Code:
Option Explicit
Private Sub cmdList_Click()
'// list the files & folders of the specified folder
ListFilesAndDirs txtFolder
End Sub
Private Sub cmdUp_Click()
Dim strFolder As String
Dim strParent As String
Dim intSlashStart As Integer
Dim intNextSlashStart As Integer
'// get current folder
strFolder = txtFolder.Text
'// end slash pos (excluding trailing )
intSlashStart = InStrRev(Left$(strFolder, Len(strFolder)
- 1), "")
'// slash before that
intNextSlashStart = InStrRev(Left$(strFolder, intSlashStart),
"")
'// and then extract the parent folder
strParent = Mid(strFolder, 1, intNextSlashStart)
'// list directories of parent
ListFilesAndDirs strParent
End Sub
Private Sub Form_Load()
'// list files
Call cmdList_Click
End Sub
Private Sub lstFolders_DblClick()
'// list files and folders of the folder that
'// has been double clicked.
ListFilesAndDirs txtFolder & lstFolders.Text
End Sub
Module Code:
Option Explicit
Public Const MAX_PATH = 260
Private Const ERROR_NO_MORE_FILES = 18&
Private Const FILE_ATTRIBUTE_DIRECTORY = &H10
Private Const FILE_ATTRIBUTE_NORMAL = &H80
Private Const FILE_ATTRIBUTE_HIDDEN = &H2
Private Const FILE_ATTRIBUTE_SYSTEM = &H4
Private Const FILE_ATTRIBUTE_TEMPORARY = &H100
Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Private Type WIN32_FIND_DATA
dwFileAttributes As Long
ftCreationTime As FILETIME
ftLastAccessTime As FILETIME
ftLastWriteTime As FILETIME
nFileSizeHigh As Long
nFileSizeLow As Long
dwReserved0 As Long
dwReserved1 As Long
cFileName As String * MAX_PATH
cAlternate As String * 14
End Type
Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA"
_
(ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA)
As Long
Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile
As Long) As Long
Private Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA"
_
(ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA)
As Long
Function StripTerminator(ByVal strString As String) As String
Dim intZeroPos As Integer
intZeroPos = InStr(strString, Chr$(0))
If intZeroPos > 0 Then
StripTerminator = Left$(strString,
intZeroPos - 1)
Else
StripTerminator = strString
End If
End Function
Function ListFilesAndDirs(ByVal sStartDir As String)
Dim lpFindFileData As WIN32_FIND_DATA, lFileHdl As
Long
Dim sTemp As String, sTemp2 As String, lRet As Long, iLastIndex
As Integer
Dim strPath As String
On Error Resume Next
'// add trailing to start directory if required
If Right$(sStartDir, 1) <> "" Then sStartDir
= sStartDir & ""
With frmExample
.txtFolder.Text = sStartDir
.lstFiles.Clear
.lstFolders.Clear
End With
sStartDir = sStartDir & "*.*"
'// get a file handle
lFileHdl = FindFirstFile(sStartDir, lpFindFileData)
If lFileHdl <> -1 Then
Do Until lRet = ERROR_NO_MORE_FILES
strPath
= Left$(sStartDir, Len(sStartDir) - 4) & ""
'// if
it is a directory
If (lpFindFileData.dwFileAttributes
And FILE_ATTRIBUTE_DIRECTORY) = vbDirectory Then
'Strip off null chars and format the string
sTemp = StrConv(StripTerminator(lpFindFileData.cFileName), vbProperCase)
' make sure it is not a reference
If sTemp <> "." And sTemp <> ".." Then
'add it to the tree view. Store its path as its Key
frmExample.lstFolders.AddItem sTemp
End If
'// if
it is a file
ElseIf
(lpFindFileData.dwFileAttributes And FILE_ATTRIBUTE_NORMAL) = vbNormal Then
sTemp = StrConv(StripTerminator(lpFindFileData.cFileName), vbProperCase)
frmExample.lstFiles.AddItem sTemp
End If
'// based
on the file handle iterate through all files and dirs
lRet =
FindNextFile(lFileHdl, lpFindFileData)
If lRet
= 0 Then Exit Do
Loop
End If
'// close the file handle
lRet = FindClose(lFileHdl)
End Function
Comments