全部
Ada助手

高分求助：用VB实现遍历目录的源代码

yannan_liv 2004-09-14 03:24:30

急等着用，现做可能来不及了，急呀。。。。有信息的大侠帮帮忙

...全文

给本帖投票

252 3 打赏收藏转发到动态举报

写回复

用AI写文章

怎样才能得到我的电脑里面的 ToolbarWindow32（工具栏）的句柄？？>>

3 条回复

切换为时间正序

请发表友善的回复…

发表回复

leolan 2004-09-14

打赏
举报

Option Explicit
'searches a directory for a file whose name matches the specified filename.
'FindFirstFile examines subdirectory names as well as filenames.
Private Declare Function FindFirstFile Lib "kernel32.dll" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindNextFile Lib "kernel32.dll" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindClose Lib "kernel32.dll" (ByVal hFindFile As Long) As Long

Private Const MAX_PATH As Long = 260
Private Const FILE_ATTRIBUTE_NORMAL As Long = &H80
Private Const FILE_ATTRIBUTE_ARCHIVE As Long = &H20
Private Const INVALID_HANDLE_VALUE As Long = -1
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 Function ListFiles(ByVal strFolder As String)
On Error GoTo ErrHandle
Dim l_strFilter As String
Dim l_blnRet As Boolean
Dim lpFFD As WIN32_FIND_DATA
Dim l_lngFindHandle As Long

l_blnRet = True
lpFFD.dwFileAttributes = FILE_ATTRIBUTE_ARCHIVE

l_strFilter = IIf(Right(strFolder, 1) = "\", strFolder, strFolder & "\") & "*.*"
l_lngFindHandle = FindFirstFile(l_strFilter, lpFFD)

If l_lngFindHandle <> INVALID_HANDLE_VALUE Then

List1.AddItem lpFFD.cFileName
Do While l_blnRet

l_blnRet = FindNextFile(l_lngFindHandle, lpFFD)
List1.AddItem lpFFD.cFileName
Loop

l_blnRet = FindClose(l_lngFindHandle)

End If

Exit Function
ErrHandle:
MsgBox Err.Description
End Function

Private Sub Command1_Click()
ListFiles "D:\VB training"
End Sub

online 2004-09-14

打赏
举报

使用fso对象
Option Explicit

Dim fso
Dim fn As String

Private Sub Command1_Click()
Dim fd As String
Set fso = CreateObject("Scripting.FileSystemObject")
List1.Clear
fd = "C:"
Call getFilenm(fd)
End Sub

Function getFilenm(fdnm As String)
Dim obFd, fl, sfd
DoEvents
Set obFd = fso.GetFolder(fdnm)
List1.AddItem fdnm

If obFd.SubFolders.Count > 0 Then
For Each sfd In obFd.SubFolders
Call getFilenm(sfd.Path)
Next
End If
End Function

northwolves 2004-09-14

打赏
举报

Dim num As Long
Sub Listfiles(ByVal mydir As String)
Dim n As Integer, dirlevel As Integer, fname As String, dirlist() As String
mydir = IIf(Right(mydir, 1) = "\", mydir, mydir & "\")
fname = Dir(mydir)
Do While fname <> ""
Debug.Print mydir & fname
num = num + 1
fname = Dir
Loop
fname = LCase(Dir(mydir, vbDirectory))
Do While fname <> ""
If fname <> "." And fname <> ".." Then
If GetAttr(mydir & fname) And vbDirectory Then
dirlevel = dirlevel + 1
ReDim Preserve dirlist(dirlevel)
dirlist(dirlevel) = mydir & fname
End If
End If
fname = Dir
DoEvents
Loop
For n = 1 To dirlevel
Listfiles dirlist(n) & "\"
Next

End Sub

Private Sub Command1_Click()
Listfiles "d:\downloads"
Debug.Print "共有" & num & "个文件"
End Sub