VB6遍历文件夹
【VBA】遍历文件夹（含子文件夹）方法
【VBA】遍历文件夹（含子文件夹）方法一、调用目标文件夹的方法1、Application.FileDialog方法Sub ListFilesT est()With Application.FileDialog(msoFileDialogFolderPicker) '运行后出现标准的选择文件夹对话框If .Show Then myPath = .SelectedItems(1) Else Exit Sub '如选中则返回=-1 / 取消未选则返回=0End WithIf Right(myPath, 1) <> '' Then myPath = myPath & '''返回的是选中目标文件夹的绝对路径,但除了本地C盘、D盘会以'C:'形式返回外，其余路径无''需要自己添加End Sub2、视窗浏览器界面选择目标文件夹Sub ListFilesT est()Set myFolder = CreateObject('Shell.Application').BrowseForFolder(0, 'GetFolder', 0)If Not myFolder Is Nothing Then myPath$ = myFolder.Items.Item.Path Else MsgBox 'Folder not Selected': Exit SubIf Right(myPath, 1) <> '' Then myPath = myPath & '''同样返回的是选中目标文件夹的绝对路径,但除了本地C盘、D盘会以'C:'形式返回外，其余路径无''需要添加End Sub二、仅列出所有文件不包括子文件夹、不包括子文件夹中的文件Sub ListFilesTest()With Application.FileDialog(msoFileDialogFolderPicker)If .Show ThenRight(myPath, 1) <> '' Then myPath = myPath & '''以上选择目标文件夹以得到路径myPath MsgBox ListFiles(myPath) '调用FSO的ListFiles过程返回目标文件夹下的所有文件名End SubFunction ListFiles(myPath$)Set fso = CreateObject('Scripting.FileSystemObject') '打开FSO脚本、建立FSO对象实例 For Each f In fso.GetFolder(myPath).Files '用FSO方法遍历指定文件夹内所有文件 i = i + 1: s = s & vbCr & '逐个列出文件名并统计文件个数 i Next ListFiles = i & ' Files:' & s '返回所有文件名的合并字符串End Function三、仅列出目标文件夹中所有子文件夹名不包括目标文件夹中文件、不包括子文件夹中的文件或子文件夹Sub ListFilesTest()With Application.FileDialog(msoFileDialogFolderPicker)If .Show Then myPath$ = .SelectedItems(1) Else Exit SubEnd WithIf Right(myPath, 1) <> '' Then myPath = myPath & '' MsgBox ListFolders(myPath)End SubFunction ListFolders(myPath$)Set fso = CreateObject('Scripting.FileSystemObject')For Each f In fso.GetFolder(myPath).SubFolders j = j + 1: t = t & vbCr & Next ListFolders = j & ' Folders:' & tEnd Functionfso.GetFolder(myPath).Filesfso.GetFolder(myPath).SubFolders四、遍历目标文件夹内所有文件、以及所有子文件夹中的所有文件【字典】Sub ListFilesTest() With Application.FileDialog(msoFileDialogFolderPicker) If .Show ThenRight(myPath, 1) <> '' Then myPath = myPath & ''MsgBox 'List Files:' & vbCr & Join(ListAllFsoDic(myPath), vbCr) MsgBox 'List SubFolders:' & vbCr & Join(ListAllFsoDic(myPath, 1), vbCr)End SubFunction ListAllFsoDic(myPath$, Optional k = 0) '使用2个字典但无需递归的遍历过程Dim i&, j& Set d1 = CreateObject('Scripting.Dictionary') '字典d1记录子文件夹的绝对路径名 Set d2 = CreateObject('Scripting.Dictionary') '字典d2记录文件名（文件夹和文件分开处理）d1(myPath) = '' '以当前路径myPath作为起始记录，以便开始循环检查Set fso = CreateObject('Scripting.FileSystemObject') Do While i < d1.Count '当字典1文件夹中有未遍历处理的key存在时进行Do循环直到 i=d1.Count即所有子文件夹都已处理时停止kr = d1.Keys '取出文件夹中所有的key即所有子文件夹路径（注意每次都要更新） For Each f In fso.GetFolder(kr(i)).Files '遍历该子文件夹中所有文件（注意仅从新的kr(i) 开始）j = j + 1: d2(j) = '把该子文件夹内的所有文件名作为字典Item项加入字典d2 (为防止文件重名不能用key属性) Nexti = i + 1 '已经处理过的子文件夹数目 i +1 （避免下次产生重复处理） For Each fd In fso.GetFolder(kr(i - 1)).SubFolders '遍历该文件夹中所有新的子文件夹 d1(fd.Path) = ' ' & & '' '把新的子文件夹路径存入字典d1以便在下一轮循环中处理 Next Loop If k Then ListAllFsoDic = d1.Keys Else ListAllFsoDic = d2.Items '如果参数=1则列出字典d1中所有子文件夹的路径名(如使用d1.Items则仅列出子文件夹名称不含路径) '如果参数=0则默认列出字典d2中Items即所有文件名 End Function【DIR】Sub ListAllDirDicTest() WithApplication.FileDialog(msoFileDialogFolderPicker) If .Show Then myPath$ = .SelectedItems(1) Else Exit Sub End With If Right(myPath, 1) <> '' Then myPath = myPath & ''MsgBox Join(ListAllDirDic(myPath), vbCr) 'GetAllSubFolder's File 列出目标文件夹内含子文件夹内所有文件MsgBox Join(ListAllDirDic(myPath, 1), vbCr) 'GetThisFolder's File 列出目标文件夹内所有文件(不含子文件夹)MsgBox Join(ListAllDirDic(myPath, -1), vbCr) 'GetThisFolder's SubFolder 仅列出目标文件夹内的子文件夹MsgBox Join(ListAllDirDic(myPath, -2), vbCr) 'GetAllSubFolder 列出目标文件夹内含子文件夹的所有子文件夹MsgBox Join(ListAllDirDic(myPath, 1, 'tst'), vbCr) 'GetThisFolder's SpecialFile 仅列出文件夹内含关键字文件 MsgBox Join(ListAllDirDic(myPath, , 'tst'), vbCr) 'GetAllSubFolder's SpecialFile 列出子文件夹内含关键字文件End SubFunction ListAllDirDic(myPath$, Optional sb& = 0, Optional SpFile$ = '') '利用Dir方法、以及用2个字典分别记录子文件夹路径和文件名的文件搜寻方法。
VBA遍历文件夹的三种方法
VBA遍历⽂件夹的三种⽅法VBA遍历⽂件夹常⽤有三种⽅法，这三种⽅法中,filesearch不适合2007和2010版本，⽽且速度⽐较慢，递归法速度也慢。
只有⽤DIR加循环的⽅法，速度飞快。
下⾯是三种⽅法的代码：1、filesearch法Sub test3()Dim wb As WorkbookDim i As LongDim tt = TimerWith Application.FileSearch '调⽤fileserch对象.NewSearch '开始新的搜索.LookIn = ThisWorkbook.path '设置搜索的路径.SearchSubFolders = True '搜索范围包括 LookIn 属性指定的⽂件夹中的所有⼦⽂件夹.Filename = "*.xls" '设置搜索的⽂件类型' .FileType = msoFileTypeExcelWorkbooksIf .Execute() > 0 Then '如果找到⽂件For i = 1 To .FoundFiles.Count'On Error Resume NextCells(i, 1) = .FoundFiles(i) '把找到的⽂件放在单元格⾥Next iElseMsgBox "没找到⽂件"End IfEnd WithMsgBox Timer - tEnd Sub2、递归法Sub Test()Dim iPath As String, i As LongDim tt = TimerWith Application.FileDialog(msoFileDialogFolderPicker).Title = "请选择要查找的⽂件夹"If .Show TheniPath = .SelectedItems(1)End IfEnd WithIf iPath = "False" Or Len(iPath) = 0 Then Exit Subi = 1Call GetFolderFile(iPath, i)MsgBox Timer - tMsgBox "⽂件名链接获取完毕。
VBA中文件夹操作与批量处理的常用函数与技巧
VBA中文件夹操作与批量处理的常用函数与技巧在使用VBA编程中，经常需要进行文件夹操作与批量处理。
本文将介绍VBA中几个常用的函数和技巧，帮助您更高效地处理文件夹和批量操作。
1. 获取文件夹路径要操作文件夹，首先需要获取文件夹的路径。
VBA提供了一个常用的函数用于获取文件夹路径，即GetFolder函数。
示例代码如下：```Dim folderPath As StringfolderPath = "C:\Users\Username\Documents\TestFolder" '替换为您想要操作的文件夹路径```2. 创建文件夹在VBA中，使用CreateFolder函数可以创建一个新的文件夹。
示例代码如下：```Dim folderPath As StringfolderPath = "C:\Users\Username\Documents\NewFolder" '替换为您想要创建的新文件夹路径If Dir(folderPath, vbDirectory) = "" ThenMkDir folderPathMsgBox "文件夹创建成功！"ElseMsgBox "文件夹已存在！"End If```在创建文件夹之前，需要使用Dir函数判断文件夹是否已存在，避免重复创建。
3. 遍历文件夹当需要对文件夹中的文件进行批量处理时，常常需要遍历文件夹中的所有文件。
可以使用FileSystemObject对象的GetFolder方法获取文件夹对象，进而遍历其中的文件。
示例代码如下：```Dim fso As ObjectDim folderPath As StringDim folder As ObjectDim file As ObjectSet fso = CreateObject("Scripting.FileSystemObject")folderPath = "C:\Users\Username\Documents\TestFolder" '替换为您想要遍历的文件夹路径Set folder = fso.GetFolder(folderPath)For Each file In folder.Files'对每个文件进行相应操作Debug.Print Next file```在遍历文件夹之前，需要创建一个FileSystemObject对象，并使用GetFolder方法获取文件夹对象。
VBA 遍历文件、文件夹
ReDim Preserve astrFolderPath(UBound(astrFolderPath()) + 1)
Next Sfld
ReDim Preserve astrFolderPath(UBound(astrFolderPath()) - 1)
Dim astrFolderPath() As String
ReDim astrFolderPath(1)
'遍历主目录下的所有子文件夹路径，存储到动态数组中
Dim Sfld As Folder
For Each Sfld In SubFlds
ReDim astrFilePath(1)
'遍历主目录下的所有文件路径，存储到动态数组中
Dim fl As File
For Each fl In fls
astrFilePath(UBound(astrFilePath())) = fl.Path
' 功能:遍历strFolderPath目录下的所有【文件】.返回数组.存储文件路径.
' 参数:strFolderPath,字符串,目录绝对路径.
' Update:2015-1-21
' Author:siyuqxxx
'--------------- GetFilesPath(strFolderPath) -----------------
' Author:siyuqxxx
'--------------- GetFoldersPath(strFolderPath） -----------------
VBA遍历文件夹下文件文件实用源码
VBA遍历⽂件夹下⽂件⽂件实⽤源码‘批量遍历⽂件夹下某类⽂件，并统计编号Sub OpenAndClose()Dim MyFile As StringDim s As StringDim count As IntegerMyFile = Dir("d:\data\" & "*.csv")'读⼊⽂件夹中第⼀个.xlsx⽂件count = count + 1 '记录⽂件的个数s = s & count & "、" & MyFileDo While MyFile <> " "MyFile = Dir '第⼆次读⼊的时候不⽤写参数If MyFile = "" ThenExit Do '当myfile为空时候说明已经遍历完了，推出do,否则要重新运⾏⼀遍End Ifcount = count + 1If count Mod 2 <> 1 Thens = s & vbTab & count & "、" & MyFileElses = s & vbCrLf & count & "、" & MyFileEnd IfLoopDebug.Print sEnd Sub‘遍历每个⽂件，并且修改⽂件，先将⽂件的名字存在数组中，然后通过数组遍历打开每个⽂件，修改，再关闭⽂件~Sub OpenCloseArray()Dim MyFile As StringDim Arr(100) As StringDim count As IntegerMyFile = Dir("D:\data\data2\" & "*.xlsx")count = count + 1Arr(count) = MyFileDo While MyFile <> ""MyFile = DirIf MyFile = "" ThenExit DoEnd Ifcount = count + 1Arr(count) = MyFile '将⽂件的名字存在数组中LoopFor i = 1 To countWorkbooks.Open Filename:="d:\data\data2\" & Arr(i) '循环打开Excel⽂件Sheet1.Cells(2, 2) = "alex_bn_lee" '修改打开⽂件的内容ActiveWorkbook.Close savechanges = True '关闭打开的⽂件Next‘要是想要修改每个⼯作簿的内容可以这样遍历⼀下，显⽰将⽂件夹中的⼯作簿的名字存到’⼀个字符串数组中，然后在⽤For...Next语句遍历‘遍历某个⽂件夹中的所有⽂件（*.*)’注意：遍历的时候，顺序完全是按照⽂件名的顺序排的，⽽不是按照⽂件夹中⽂件的顺序~Sub dlkfjdl()Dim MyFile As StringDim count As Integercount = 1MyFile = Dir("d:\data\*.*")Debug.Print "1、" & MyFileDo While MyFile <> ""count = count + 1MyFile = DirIf MyFile = "" Then Exit DoDebug.Print count & "、" & MyFileLoopEnd Sub。
VB遍历文件夹大小原码下载
' Set the Browse dialog root folder
nFolder = GetFolderValue(1) '(m_wCurOptIdx)
' Fill the item id list with the pointer of the selected folder item, rtns 0 on success
' Frees the memory SHBrowseForFolder()
' allocated for the pointer to the item id list
CoTaskMemFree pIdl
End Sub
Private Sub ShowFolderList(folderspec)
' See BrowsDlg.bas for the system folder nFolder values
' The Desktop
If wIdx < 2 Then
GetFolderValue = 0
' Programs Folder --> Start Menu Folder
SHGFI_PIDL Or SHGFI_ICON
' SHFI.hIcon is OK here so DrawIcon() can be used
DrawIcon pic32Icon.hdc, 0, 0, SHFI.hIcon
pic32Icon.Refresh
'Call ShowFolderList(folderspec & "\" & )
用VBA遍历指定文件夹里包括子文件夹里的所有文件
用VBA遍历指定文件夹里包括子文件夹里的所有文件如何用VBA遍历指定文件夹内的所有文件?如果仅仅是指定文件夹下的文件而不包括子文件夹内文件的话，那好办。
一个Do...While加上Dir就可以搞定。
要包括子文件夹，那就要费一番小功夫了。
网上没有找到用Dir的完美答案，所以参考网上的思路，根据自己的理解编了一个，以备后用。
主要还是利用两个字典对象及递归的思想。
------------------------------------------------Sub test()Dim startfolder As Stringstartfolder = "D:\starcraft\" '指定文件夹Set folderlist = CreateObject("scripting.dictionary")Set filelist = CreateObject("scripting.dictionary")i = 1folderlist.Add startfolder, ""Do While folderlist.Count > 0For Each FolderName In folderlist.keysfname = Dir(FolderName, vbDirectory)Do While fname <> ""If fname <> ".." And fname <> "." ThenIf GetAttr(FolderName & fname) And vbDirectory Thenfolderlist.Add FolderName & fname & "\", ""Elsefilelist.Add FolderName & fname, "" '这里列出的该文件的路径＋文件名End IfEnd Iffname = DirLoopfolderlist.Remove (FolderName)NextLoopFor Each arr In filelist.keys ‘将文件路径＋文件名放在当前工作表的A列Range("A" & i).Value = arri = i + 1NextEnd Sub。
VBA遍历所有文件夹的两种方法(filesearch和FileSystemObject)
VBA遍历所有文件夹的两种方法（filesearch和FileSystemObject）在VBA遍历文件夹和子文件夹中所有文件，常用两种方法，一种是使用VBA的filesercth对象，另外一种是使用FileSystemObject(windows文件管理工具)和递归方法。
兰色对代码进行了注解，希望对大家有所帮助第一种方法：使用filesearch对象Sub mysearch()Dim fs, i, arr(1 To 10000)Set fs = Application.FileSearch '设置一个搜索对象With fs.LookIn = ThisWorkbook.Path & "/" '设置搜索路径.Filename = "*.xls" '要搜索文件名和类型.SearchSubFolders = True '是否需要搜索子文件夹If .Execute > 0 Then '如果找不到文件MsgBox "There were " & .FoundFiles.Count & _" file(s) found." '显示文件找不到For i = 1 To .FoundFiles.Count '通过循环把所有搜索到的文件存入到数组中arr(i) = .FoundFiles(i)Next iSheets(1).Range("A1").Resize(.FoundFiles.Count) = Application.Transpose(arr) ' '把数组内的路径和文件名放在单元格中ElseMsgBox "There were no files found."End IfEnd WithEnd Sub第二种方法：引用FileSystemObject对象注意：要使用FileSystemObject对象，需要首先引用一下，具体方法，VBE--工具--引用--找到miscrosoft scription runtime项目并选中代码及注释：Dim ArrFiles(1 To 10000) '创建一个数组空间,用来存放文件名称Dim cntFiles% '文件个数Public Sub ListAllFiles()Dim strPath$ '声明文件路径Dim i%'Set fso = CreateObject("Scripting.FileSystemObject")Dim fso As New FileSystemObject, fd As Folder '创建一个FileSystemObject对象和一个文件夹对象strPath = ThisWorkbook.Path & "/" '"设置要遍历的文件夹目录cntFiles = 0Set fd = fso.GetFolder(strPath) '设置fd文件夹对象SearchFiles fd '调用子程序查搜索文件Sheets(1).Range("A1").Resize(cntFiles) = Application.Transpose(ArrFiles) '把数组内的路径和文件名放在单元格中End SubSub SearchFiles(ByVal fd As Folder)Dim fl As FileDim sfd As FolderFor Each fl In fd.Files '通过循环把文件逐个放在数组内cntFiles = cntFiles + 1ArrFiles(cntFiles) = fl.PathNext flIf fd.SubFolders.Count = 0 Then Exit Sub 'SubFolders返回由指定文件夹中所有子文件夹（包括隐藏文件夹和系统文件夹）组成的Folders 集合For Each sfd In fd.SubFolders '在Folders 集合进行循环查找SearchFiles sfd '使用递归方法查找下一个文件夹NextEnd Sub。
- 1、下载文档前请自行甄别文档内容的完整性，平台不提供额外的编辑、内容补充、找答案等附加服务。
- 2、"仅部分预览"的文档,不可在线预览部分如存在完整性等问题,可反馈申请退款(可完整预览的文档不适用该条件!)。
- 3、如文档侵犯您的权益，请联系客服反馈,我们会尽快为您处理(人工客服工作时间：9:00-18:30)。
//思路: 使用FINDFIRST FINDNEXT 函数递归实现查找
/*
在VB中WIN32_FIND_DATA 的
cFileName 返回的总是256个字符即MAX_PATH长度的字符,其中包含文件名和空格,需用getstr 获取取中的文件名
*/
’程序:
'引用 microsft scripting runtime
Dim file As New FileSystemObject
Dim txtstream As TextStream
Public Sub cbfindfile(str2 As String)
fext = getext(str2)
If (LCase(fext) = "cpp" Or LCase(fext) = "h" Or LCase(fext) = "inc" Or LCase(fext) = "txt" Or LCase(fext) = "doc") Then
Set txtstream = file.OpenTextFile(str2, ForReading)
strtxt = LCase(txtstream.ReadAll)
pos = InStr(1, strtxt, "p0", 1) '查找的内容
If (pos <> 0) Then
Form1.List1.AddItem str2
End If
End If
End Sub
Private Sub Command1_Click()
findfile "d:\51"
End Sub
’模块文件:
Public Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
'查找下一个文件的API
Public Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
'获取文件属性的API
Public Declare Function GetFileAttributes Lib "kernel32" Alias "GetFileAttributesA" (ByVal lpFileName As String) As Long
'关闭查找文件的API
Public Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long Const MAX_PATH = 260
Const MAXDWORD = &HFFFF
Const FILE_ATTRIBUTE_DIRECTORY = &H10
Public Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Dim tempstr As String
'定义类(用于查找文件)
Public 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
Public Function getstr(str1 As String) As String Dim slen As Long
For i = 1 To MAX_PATH
If (Asc(Mid(str1, i, 1)) = 0) Then
slen = i - 1
Exit For
End If
Next
getstr = Left(str1, slen)
End Function
Public Sub findfile(path As String) '遍历文件
Dim fhand As Long
Dim wfd As WIN32_FIND_DATA
Dim bl As Boolean
bl = True
fhand = FindFirstFile(path & "\*.*", wfd)
While bl
fname = getstr(wfd.cFileName)
If (fname <> "." And fname <> "..") Then
If (wfd.dwFileAttributes And vbDirectory) Then findfile (path & "\" & fname)
Else
Form1.cbfindfile (path & "\" & fname) '找到文件
End If
End If
bl = FindNextFile(fhand, wfd)
Wend
FindClose (fhand)
End Sub
Public Function getext(str1 As String) As String '获取扩展名For i = Len(str1) To 1 Step -1
If (Mid(str1, i, 1) = ".") Then
getext = Right(str1, Len(str1) - i)
Exit For
End If
Next
End Function。