VB遍历文件目录的实现方法总结_vb中遍历文件夹的方法

VB遍历文件目录的实现方法总结由刀豆文库小编整理，希望给你工作、学习、生活带来方便，猜你可能喜欢“vb中遍历文件夹的方法”。

VB遍历文件目录的实现方法总结

2009-04-25 20:44VB遍历文件夹的实现方法总结一共三种，如下： 使用FSO对象模型

'=============================== '描述：需要Scripting类型库（Scrrun.dll）支持。实际使用时需要引用Microsoft Scripting Runtime '优点：测试当中没有错误。可以检测隐藏文件。

'示例：一个文本标签、一个ListBox、一个命令按钮。都取默认名称即可

'=============================== Dim fso As New FileSystemObject Dim fld As Folder

Private Sub Command1_Click()

Dim nDirs As Long, nFiles As Long, lSize As Currency

Dim sDir As String, sSrchString As String

sDir = InputBox(“Type the directory that you want to search for”, _

“FileSystemObjects example”, “C:”)

sSrchString = InputBox(“Type the file name that you want to search for”, _

“FileSystemObjects example”, “vb.ini”)

MousePointer = vbHourgla

Label1.Caption = “Searching ” & vbCrLf & UCase(sDir)& “...”

lSize = FindFile(sDir, sSrchString, nDirs, nFiles)

MousePointer = vbDefault

MsgBox Str(nFiles)& “ files found in” & Str(nDirs)& _

“ directories”, vbInformation

MsgBox “Total Size = ” & lSize & “ bytes” End Sub

Private Function FindFile(ByVal sFol As String, sFile As String, _

nDirs As Long, nFiles As Long)As Currency

Dim tFld As Folder, tFil As File, FileName As String

On Error GoTo Catch

Set fld = fso.GetFolder(sFol)

FileName = Dir(fso.BuildPath(fld.Path, sFile), vbNormal Or _

vbHidden Or vbSystem Or vbReadOnly)

While Len(FileName)0

FindFile = FindFile + FileLen(fso.BuildPath(fld.Path, _

FileName))

nFiles = nFiles + 1

List1.AddItem fso.BuildPath(fld.Path, FileName)' Load ListBox

FileName = Dir()' Get next file

DoEvents

Wend

Label1 = “Searching ” & vbCrLf & fld.Path & “...”

nDirs = nDirs + 1

If fld.SubFolders.Count > 0 Then

For Each tFld In fld.SubFolders

DoEvents

FindFile = FindFile + FindFile(tFld.Path, sFile, nDirs, nFiles)

Next

End If

Exit Function Catch: FileName = “”

Resume Next End Function Api方法

'================================== '描述：使用Api。

'备注：使用过程中出现错误。未加分析。忽略错误即可。'

可查看隐藏文件。

'示例：2个listbox、2个命令按钮、6个文本框、一个模块

=================================== '模块代码

Option Explicit

Declare Function FindFirstFile Lib “kernel32” Alias _

“FindFirstFileA”(ByVal lpFileName As String, lpFindFileData _

As WIN32_FIND_DATA)As Long

Declare Function FindNextFile Lib “kernel32” Alias “FindNextFileA” _

(ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA)As Long

Declare Function GetFileAttributes Lib “kernel32” Alias _

“GetFileAttributesA”(ByVal lpFileName As String)As Long

Declare Function FindClose Lib “kernel32”(ByVal hFindFile As Long)_

As Long

Declare Function FileTimeToLocalFileTime Lib “kernel32” _

(lpFileTime As FILETIME, lpLocalFileTime As FILETIME)As Long

Declare Function FileTimeToSystemTime Lib “kernel32” _

(lpFileTime As FILETIME, lpSystemTime As SYSTEMTIME)As Long

Public Const MAX_PATH = 260

Public Const MAXDWORD = &HFFFF

Public Const INVALID_HANDLE_VALUE =-1

Public Const FILE_ATTRIBUTE_ARCHIVE = &H20

Public Const FILE_ATTRIBUTE_DIRECTORY = &H10

Public Const FILE_ATTRIBUTE_HIDDEN = &H2

Public Const FILE_ATTRIBUTE_NORMAL = &H80

Public Const FILE_ATTRIBUTE_READONLY = &H1

Public Const FILE_ATTRIBUTE_SYSTEM = &H4

Public Const FILE_ATTRIBUTE_TEMPORARY = &H100

Type FILETIME

dwLowDateTime As Long

dwHighDateTime As Long

End Type

Type WIN32_FIND_DATA

dwFileAttributes As Long

ftCreationTime As FILETIME

ftLastAcceTime 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

Type SYSTEMTIME

wYear As Integer

wMonth As Integer

wDayOfWeek As Integer

wDay As Integer

wHour As Integer

wMinute As Integer

wSecond As Integer

wMilliseconds As Integer

End Type

Public Function StripNulls(OriginalStr As String)As String

If(InStr(OriginalStr, Chr(0))> 0)Then

OriginalStr = Left(OriginalStr, _

InStr(OriginalStr, Chr(0))1

FindFilesAPI = FindFilesAPI + FindFilesAPI(path & dirNames(i)_

& “”, SearchStr, FileCount, DirCount)

Next i

End If

End Function

Private Sub Command1_Click()

On Error Resume Next

Dim SearchPath As String, FindStr As String

Dim FileSize As Long

Dim NumFiles As Integer, NumDirs As Integer

Screen.MousePointer = vbHourgla

List1.Clear

SearchPath = Text1.Text

FindStr = Text2.Text

FileSize = FindFilesAPI(SearchPath, FindStr, NumFiles, NumDirs)

Text3.Text = NumFiles & “ Files found in ” & NumDirs + 1 & _

“ Directories”

Text4.Text = “Size of files found under ” & SearchPath & “ = ” & _

Format(FileSize, “#,###,###,##0”)& “ Bytes”

Screen.MousePointer = vbDefault

End Sub

Function FindFiles(path As String, SearchStr As String, _

FileCount As Integer, DirCount As Integer)

Dim FileName As String

' Walking filename variable.Dim DirName As String

' SubDirectory Name.Dim dirNames()As String ' Buffer for directory name entries.Dim nDir As Integer

' Number of directories in this path.Dim i As Integer

' For-loop counter.On Error GoTo sysFileERR

If Right(path, 1)“” Then path = path & “”

' Search for subdirectories.nDir = 0

ReDim dirNames(nDir)

DirName = Dir(path, vbDirectory Or vbHidden Or vbArchive Or vbReadOnly _ Or vbSystem)' Even if hidden, and so on.Do While Len(DirName)> 0

' Ignore the current and encompaing directories.If(DirName “.”)And(DirName “..”)Then

' Check for directory with bitwise comparison.If GetAttr(path & DirName)And vbDirectory Then

dirNames(nDir)= DirName

DirCount = DirCount + 1

nDir = nDir + 1

ReDim Preserve dirNames(nDir)

'List2.AddItem path & DirName ' Uncomment to list

End If

' directories.sysFileERRCont:

End If

DirName = Dir()' Get next subdirectory.Loop

' Search through this directory and sum file sizes.FileName = Dir(path & SearchStr, vbNormal Or vbHidden Or vbSystem _

Or vbReadOnly Or vbArchive)

While Len(FileName)0

FindFiles = FindFiles + FileLen(path & FileName)

FileCount = FileCount + 1

' Load List box

List2.AddItem path & FileName & vbTab & _

FileDateTime(path & FileName)

' Include Modified Date

FileName = Dir()' Get next file.Wend

' If there are sub-directories..If nDir > 0 Then

' Recursively walk into them

For i = 0 To nDir“ & Err.Description, , _

”Unexpected Error“

Resume AbortFunction

End If

End Function

Private Sub Command2_Click()

On Error Resume Next

Dim SearchPath As String, FindStr As String

Dim FileSize As Long

Dim NumFiles As Integer, NumDirs As Integer

Screen.MousePointer = vbHourgla

List2.Clear

SearchPath = Text1.Text

FindStr = Text2.Text

FileSize = FindFiles(SearchPath, FindStr, NumFiles, NumDirs)

Text5.Text = NumFiles & ” Files found in “ & NumDirs + 1 & _

” Directories“

Text6.Text = ”Size of files found under “ & SearchPath & ” = “ & _

Format(FileSize, ”#,###,###,##0“)& ” Bytes“

Screen.MousePointer = vbDefault

End Sub

Private Sub Form_Load()

Command1.Caption = ”Use API code“

Command2.Caption = ”Use VB code“

' start with some reasonable defaults

Text1.Text = ”C:My Documents“

Text2.Text = ”*.*“

End Sub 使用系统控件

'=================================== '描述：简单易于实现

'

不可查看隐藏文件

'示例：一个目录操作经典三联组合。一个命令按钮。

'===================================

Private Sub Command1_Click()List1.Clear sosuofile(Dir1.List(Dir1.ListIndex))MsgBox ”搜索完毕！，共找到“ + Str(List1.ListCount)+ ”条记录。“, vbOKOnly + vbExclamation, ”提示“ End Sub

Private Sub Drive1_Change()Dir1.Path = Drive1.Drive End Sub Sub sosuofile(MyPath As String)Dim Myname As String Dim dir_i()As String Dim i, idir As Long If Right(MyPath, 1)”“ Then MyPath = MyPath + ”“ Myname = Dir(MyPath, vbDirectory Or vbHidden Or vbNormal Or vbReadOnly)Do While Myname ”“ If Myname ”.“ And Myname ”.." Then If(GetAttr(MyPath & Myname)And vbDirectory)= vbDirectory Then '如果找到的是目录 idir = idir + 1 ReDim Preserve dir_i(idir)As String dir_i(idir1 Call sosuofile(MyPath + dir_i(i))Next i ReDim dir_i(0)As String End Sub