1、遍历文件
我们在VBA中遍历获取所有文件的方法一般是使用下面3种:
- 调用Dir函数
- 使用FileSystemObject
- 使用cmd命令
Dir方法是VBA里封装好了的,但是对于判段是否是文件夹并没有很好的方法,一般是利用文件名是否包含“.”来判断,但这个是很不严谨的。
不过这个方法其实和Windows API的使用方法很相近,只是他的返回值太单一了一点:
代码语言:javascript复制Sub TestVBADir()
VBADirR "path"
End Sub
Function VBADirR(strdir As String) As Long
Dim fn As String
fn = VBA.Dir(strdir & "*", vbDirectory)
Do Until fn = ""
If fn <> "." And fn <> ".." Then
Debug.Print fn
End If
fn = VBA.Dir()
Loop
End Function
FileSystemObject方法是对象形式的,好理解。
cmd命令最简单,用dir命令就可以。
这2种方法我在VBA汇总多个Excel文件数据里使用过。
这些方法的底层应该都是调用了Windows API来实现,让我们看看如何直接使用Windows API来实现遍历文件。
2、代码实现
主要使用的是FindFirstFile和FindNextFile2个API:
代码语言:javascript复制Const MAX_PATH As Long = 260
Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
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 FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
Private Const INVALID_HANDLE_VALUE As Long = -1
Private Const FILE_ATTRIBUTE_ARCHIVE As Long = &H20
Private Const FILE_ATTRIBUTE_COMPRESSED As Long = &H800
Private Const FILE_ATTRIBUTE_DEVICE As Long = &H40
Private Const FILE_ATTRIBUTE_DIRECTORY As Long = &H10
Private Const FILE_ATTRIBUTE_ENCRYPTED As Long = &H4000
Private Const FILE_ATTRIBUTE_HIDDEN As Long = &H2
Private Const FILE_ATTRIBUTE_NORMAL As Long = &H80
Private Const FILE_ATTRIBUTE_NOT_CONTENT_INDEXED As Long = &H2000
Private Const FILE_ATTRIBUTE_OFFLINE As Long = &H1000
Private Const FILE_ATTRIBUTE_READONLY As Long = &H1
Private Const FILE_ATTRIBUTE_REPARSE_POINT As Long = &H400
Private Const FILE_ATTRIBUTE_SPARSE_FILE As Long = &H200
Private Const FILE_ATTRIBUTE_SYSTEM As Long = &H4
Private Const FILE_ATTRIBUTE_TEMPORARY As Long = &H100
Sub ScanDir()
ScanDirR "path*"
End Sub
Function ScanDirR(lpFileName As String) As Long
Dim hFindFile As Long
Dim fd As WIN32_FIND_DATA
hFindFile = FindFirstFile(lpFileName, fd)
If hFindFile = INVALID_HANDLE_VALUE Then
Debug.Print lpFileName, "FindFirstFile出错"
Exit Function
End If
Dim path As String
path = VBA.Left$(lpFileName, VBA.InStrRev(lpFileName, ""))
Dim ret As Long
ret = 1
'返回的文件名中会包含"."和".."
'“.'代表本目录,".."代表上一层目录
'一般情况下需要把这两个名称过滤掉
Dim tmp As String
Do While ret
tmp = GetFileName(fd.cFileName)
If tmp <> "." And tmp <> ".." Then
If fd.dwFileAttributes = FILE_ATTRIBUTE_DIRECTORY Then
ScanDirR path & tmp & "*"
Else
'输出文件名中包含“xls”的文件
If tmp Like "*xls*" Then Debug.Print path & tmp, VBA.Hex(fd.dwFileAttributes)
End If
End If
ret = FindNextFile(hFindFile, fd)
Loop
FindClose hFindFile
End Function
'去除多余的空字符
Function GetFileName(str As String) As String
Dim index As Long
index = VBA.InStr(str, VBA.Chr(0))
If index Then
GetFileName = VBA.Left$(str, index - 1)
Else
GetFileName = str
End If
End Function
3、小结
使用API来实现遍历文件功能可以增强我们的灵活性,因为返回值WIN32_FIND_DATA里面记录了较多信息,理解这个也能让我们明白底层的一些原理。