Excel使用Vba读取文件夹下所有文件
怎么通过vba获取一个目录下的所有文件夹名称、大小、文件夹中所有文档数量
怎么通过vba获取一个目录下的所有文件夹名称、大小、文件夹中所有文档数量如何通过vba获取一个目录下的所有文件夹名称、大小、文件夹中所有文档数量？如何通过vba获取一个目录下的所有文件夹名称、大小、文件夹中所有文档数量？例如：vb-vba1-1.txt-2.txt-vba2-3.txt-vba3需要的结果是:文件夹名称文件夹大小文件夹文档数量vba1 2vba2 1vba3 0------解决方案--------------------<hta><head><META HTTP-EQUIV= "pragma " CONTENT= "no-cache "> <META HTTP-EQUIV= "Cache-Control " CONTENT= "no-cache, must-revalidate "><META HTTP-EQUIV= "expires " CONTENT= "0 "><title> 命名程序 </title></head><body scroll= "auto " style= "border:none; color:green; " bgcolor=black topmargin=0 leftmargin=0 rightmargin=0 bottommargin=0 ><textarea id=show rows=10 style= "width:100%; "> </textarea><textarea id=dofile rows=20 style= "width:100%; " title=请在这输入处理文件的方法> function (path){请在这输入处理文件的方法,其它不变。
使用VBA进行文件和文件夹的批量处理
使用VBA进行文件和文件夹的批量处理在日常工作中，我们经常需要对多个文件和文件夹进行一系列的操作，比如重命名、复制、移动、删除等等。
手动一个一个操作无疑是很繁琐和费时的。
而使用VBA（Visual Basic for Applications）可以帮助我们实现对文件和文件夹的批量处理，提高工作效率。
本文将介绍如何使用VBA对文件和文件夹进行常见的批量处理操作。
首先，我们需要打开Excel，并按下Alt + F11快捷键，打开VBA编辑器。
接下来，在VBA编辑器中插入一个新的模块，以便我们可以编写VBA代码。
1. 获取文件和文件夹路径在进行批量处理之前，我们需要获取待处理的文件和文件夹的路径。
我们可以使用VBA中的FileDialog对象来实现这一功能。
下面是一段示例代码，用于打开文件对话框并获取用户选择的文件路径：```Sub GetFilePath()Dim fd As FileDialogDim selectedFile As Variant'创建文件对话框对象Set fd = Application.FileDialog(msoFileDialogFilePicker)'设置文件对话框属性With fd.Title = "请选择要处理的文件".AllowMultiSelect = False'检查用户是否选择了文件If .Show = -1 ThenFor Each selectedFile In .SelectedItems'处理文件路径'将路径存储到变量中，以备后续使用Next selectedFileElse'用户取消选择文件，提示错误信息或者退出程序End IfEnd With'释放对象Set fd = NothingEnd Sub```同样，在获取文件夹路径时，我们也可以使用FileDialog对象，只需将msFileDialogFilePicker更改为msFileDialogFolderPicker即可。
Excel使用Vba读取文件夹下所有文件
Excel使用Vba读取文件夹下所有文件最近使用VBA编程，要用到一个功能，使得Excel能够读取指定文件夹下的所有文件名称。
使用的是Excel2010版本，但是在Excel2003版本中能够使用的在Excel2010版中会出错，因此不得不另找其它方法，下面介绍三种方法，在Excel单元格中显示特定目录下的文件名称（文件大小，日期时间等），也可以自行修改符合自己的使用要求。
在Excel2010和Excel2003版本中均测试过可行。
我工作中使用繁体，第三种方法使用的是繁体，所以在简体系统下会乱码，这个不会妨碍程序运行，gongxi1是我设置的一个窗体，可忽略。
第三种不仅仅能导入特定文件下的所有文件，也可以导入文件夹下的文件夹文件。
第一种：Sub testit()Dim k As VariantDim m As Variantm = 1myvar = ("C:\Users\ownding\SkyDrive\文档\工作事項")For i = LBound(myvar) To UBound(myvar)Debug.Print myvar(i)NextFor Each k In myvarSheets("sheet1").Cells(m, 1) = km = m + 1Next kEnd SubFunction (fldr As String, Optional fltr As String = "*.*") As VariantDim sTemp As String, sHldr As StringIf Right$(fldr, 1) <> "" Then fldr = fldr & ""sTemp = Dir(fldr & fltr)If sTemp = "" Then= Split("No files found", "|") '确保返回数组Exit FunctionEnd IfDosHldr = DirIf sHldr = "" Then Exit DosTemp = sTemp & "|" & sHldrLoop= Split(sTemp, "|")End Function-----------------------------------------------------------------------------第二种：Option ExplicitSub ListFiles()Dim Directory As StringDim r As LongDim f As StringDim As DoubleWith Application.(mso).Initial = Application.Default & "".Title = "Select a location containing the files you want to list." .ShowIf .SelectedItems.Count = 0 ThenExit SubElseDirectory = .SelectedItems(1) & ""End IfEnd Withr = 1' 插入表头Cells.ClearContentsCells(r, 1) = "Files in " & DirectoryCells(r, 2) = "Size"Cells(r, 3) = "Date/Time"Range("A1:C1").Font.Bold = True' 获得第一个文件f = Dir(Directory, vbReadOnly + vbHidden + vbSystem) Do While f <> ""r = r + 1Cells(r, 1) = f。
vba dir函数用法
vba dir函数用法VBADir数，也称为 Visual Basic for Applications录功能，是指在 Excel作表中执行的一类特殊操作。
它可以用来在文件夹中寻找指定的文件或文件夹。
Dir数可以用来读取磁盘中指定的文件和文件夹的详细信息，包括文件名、文件大小、文件类型等。
VBA Dir数的基本用法VBA Dir数的基本用法如下：Dir(path)其中 path指要搜索的文件夹或文件路径。
如果要查找指定文件夹内的文件，可以使用如下 Dir数语法： Dir(path, Attribute)其中 path指要搜索的文件夹，Attribute指要搜索的文件属性，可用通过下列值来指定文件的属性：0 vbNormal：表示搜索正常文件。
1 vbReadOnly：表示搜索只读文件。
2 vbHidden：表示搜索隐藏文件。
4 vbSystem：表示搜索系统文件。
8 vbVolume：表示搜索卷标。
16 vbDirectory：表示搜索文件夹。
32 vbAlias：表示搜索文件别名。
VBA Dir数如何使用VBA Dir数可以用来检索指定文件夹内的文件或文件夹，并获取相关信息，例如文件名、文件大小、文件类型等。
可以使用以下 VBA 代码来获取指定文件夹内的所有文件的详细信息：Sub ListFiles()Dim MyPath As String义目标文件夹MyPath = C:myFolder义文件名变量Dim FileName As String置 FileName量为第一个文件的文件名FileName = Dir(MyPath & *.txt vbNormal)Do Until FileName =印文件的详细信息Debug.Print FileName置 FileName量为下一个文件的文件名FileName = DirLoopEnd Sub上例中， Dir数用来获取 MyPath指定路径中,后缀为txt的文件名，vbNormal定寻找的文件类型，以此类推，可以查找指定路径下的其它类型文件。
VBA遍历文件夹和子文件夹中所有文件
在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。
VBA批量处理Excel文件的方法与技巧
VBA批量处理Excel文件的方法与技巧Excel是一款功能强大的办公软件，常被用于数据处理和数据分析。
而VBA（Visual Basic for Applications）是一种编程语言，可以用于扩展和自动化Excel的功能。
在本文中，我们将探讨使用VBA批量处理Excel文件的一些方法与技巧。
1. 遍历文件夹中的所有Excel文件在处理大量的Excel文件时，很可能需要先找到文件夹中的所有文件，并对每个文件进行相同的操作。
VBA提供了一种遍历文件夹中文件的方法。
首先，我们需要使用FileSystemObject对象来引用文件系统。
然后，使用GetFolder 方法来获取文件夹对象。
接下来，使用Files属性来获取文件夹中的所有文件，并使用For Each循环逐个处理。
```vbaOption ExplicitSub ProcessFilesInFolder()Dim FolderPath As StringDim FileName As StringDim wb As WorkbookFolderPath = "C:\Folder\Path\"FileName = Dir(FolderPath & "*.xlsx")Do While FileName <> ""Set wb = Workbooks.Open(FolderPath & FileName)' 执行相应的操作wb.Close SaveChanges:=TrueFileName = DirLoopEnd Sub```2. 自动化操作VBA可以用于自动化执行Excel中的各种操作，如数据导入导出、格式设置、图表生成等。
以数据导入为例，我们可以使用VBA代码将其他文件中的数据快速导入到Excel中。
```vbaOption ExplicitSub ImportData()Dim ws As WorksheetDim wb As Workbook' 打开文件对话框选择要导入的文件Application.Dialogs(xlDialogOpen).ShowSet wb = ActiveWorkbookSet ws = ThisWorkbook.Worksheets("Sheet1") ' 修改为相应的工作表名称' 将选定的工作簿的数据复制到当前工作簿的Sheet1工作表wb.Sheets(1).UsedRange.Copy ws.Range("A1")' 关闭选定的工作簿，保存更改wb.Close SaveChanges:=FalseEnd Sub```3. 批量修改文件中的数据如果需要在多个Excel文件中修改相同的数据，可以使用VBA来批量处理。
用VBA获取文件夹中的文件列表
用VBA获取文件夹中的文件列表展开全文如果我们要在Excel中获取某个文件夹中所有的文件列表，可以通过下面的VBA代码来进行。
代码运行后，首先弹出一个浏览文件夹对话框，然后新建一个工作簿，并在工作表的A至F列分别列出选定文件夹中的所有文件的文件名、文件大小、创建时间、修改时间、访问时间及完整路径。
方法如下：1.按Alt+F11，打开VBA编辑器，单击菜单“插入→模块”，将下面的代码粘贴到右侧的代码窗口中：Sub GetFileList()Dim strFolder As StringDim varFileList As VariantDim FSO As Object, myFile As ObjectDim myResults As VariantDim l As Long'显示打开文件夹对话框With Application.FileDialog(msoFileDialogFolderPicker).ShowIf .SelectedItems.Count = 0 Then Exit Sub '未选择文件夹strFolder = .SelectedItems(1)End With'获取文件夹中的所有文件列表varFileList = fcnGetFileList(strFolder)If Not IsArray(varFileList) ThenMsgBox "未找到文件", vbInformationExit SubEnd If'获取文件的详细信息，并放到数组中ReDim myResults(0 To UBound(varFileList) + 1, 0 To 5)myResults(0, 0) = "文件名"myResults(0, 1) = "大小（字节）"myResults(0, 2) = "创建时间"myResults(0, 3) = "修改时间"myResults(0, 4) = "访问时间"myResults(0, 5) = "完整路径"Set FSO = CreateObject("Scripting.FileSystemObject")For l = 0 To UBound(varFileList)Set myFile = FSO.GetFile(strFolder & "\" & CStr(varFileList(l))) myResults(l + 1, 0) = CStr(varFileList(l))myResults(l + 1, 1) = myFile.SizemyResults(l + 1, 2) = myFile.DateCreatedmyResults(l + 1, 3) = myFile.DateLastModifiedmyResults(l + 1, 4) = myFile.DateLastAccessedmyResults(l + 1, 5) = myFile.PathNext lfcnDumpToWorksheet myResultsSet myFile = NothingSet FSO = NothingEnd SubPrivate Function fcnGetFileList(ByVal strPath As String, Optional strFilter As String) As Variant' 将文件列表放到数组Dim f As StringDim i As IntegerDim FileList() As StringIf strFilter = "" Then strFilter = "*.*"Select Case Right(strPath, 1)Case "\", "/"strPath = Left(strPath, Len(strPath) - 1)End SelectReDim Preserve FileList(0)f = Dir(strPath & "\" & strFilter)Do While Len(f) > 0ReDim Preserve FileList(i) As StringFileList(i) = fi = i + 1f = Dir()LoopIf FileList(0) <> Empty ThenfcnGetFileList = FileListElsefcnGetFileList = FalseEnd IfEnd FunctionPrivate Sub fcnDumpToWorksheet(varData As Variant, Optional mySh As Worksheet)Dim iSheetsInNew As IntegerDim sh As Worksheet, wb As WorkbookDim myColumnHeaders() As StringDim l As Long, NoOfRows As LongIf mySh Is Nothing Then'新建一个工作簿iSheetsInNew = Application.SheetsInNewWorkbookApplication.SheetsInNewWorkbook = 1Set wb = Application.Workbooks.AddApplication.SheetsInNewWorkbook = iSheetsInNewSet sh = wb.Sheets(1)ElseSet mySh = shEnd IfWith shRange(.Cells(1, 1), .Cells(UBound(varData, 1) + 1, UBound(varData, 2) + 1)) = varData.UsedRange.Columns.AutoFitEnd WithSet sh = NothingSet wb = NothingEnd Sub2.关闭VBA编辑器，回到Excel工作表中，按Alt+F8，打开“宏”对话框，选择“GetFileList”，单击“运行”按钮。
每日Excel分享（函数VBA技巧）提取文件夹里面所有文件名称的三种方法，总有一种是你想要的...
每日Excel分享（函数VBA技巧）提取文件夹里面所有文件名称的三种方法，总有一种是你想要的...感谢关注导读方法:1：使用宏表函数FILES首先定义一个名为“获取文件名”的名称，引用位置输入：=FILES('F:\测试目录\*.*')然后在A2单元格输入公式=INDEX(获取文件名,ROW(A1))，公式下拉即可方法2：使用VBA代码操作方法：按ALT F11组合键打开VBE编辑器，选中任意一个工作表名点击右键，然后选择“插入——模块”，在模块中粘贴以下代码：Sub 提取指定文件夹内的所有文件名() '含所有子文件夹内的文件Dim Fso As Object, arrf$(), mf&, p$With Application.FileDialog(msoFileDialogFolderPicker)If .Show = False Then Exit Subp = .SelectedItems(1) & ''End WithSet Fso = CreateObject('Scripting.FileSystemObject')Call GetFiles(p, Fso, arrf, mf)[A2:A65536].Delete[A2].Resize(mf) = Application.Transpose(arrf)Set Fso = NothingEnd SubPrivate Sub GetFiles(ByVal sPath$, ByRef Fso As Object, ByRef arrf$(), ByRef mf&)Dim Folder As ObjectDim SubFolder As ObjectDim File As ObjectSet Folder = Fso.GetFolder(sPath)For Each File In Folder.Filesmf = mf 1ReDim Preserve arrf(1 To mf)arrf(mf) = NextFor Each SubFolder In Folder.SubFoldersCall GetFiles(SubFolder.Path, Fso, arrf, mf)NextSet Folder = NothingSet File = NothingEnd SubPS：上面代码来源于EH论坛。
VBA打开文件夹下所有文件
‘sub xlsOpen()Set rrr = CreateObject("Scripting.FileSystemObject")Set r = rrr.GetFolder("D:\EXCEL练习\")Application.ScreenUpdating = FalseFor Each i In r.FilesWorkbooks.Open Filename:=(" D:\EXCEL练习\" + + "")Sheets(1).Cells(2,5 )=“10”ActiveWorkbook.Close savechanges:=trueNextApplication.ScreenUpdating = True‘End SubExecuteExcel4Macro "PRINT(1,,,1,,,,,,,,2,,,TRUE,,FALSE)" ‘打印当前SHEETActiveWorkbook.Close savechanges:=false ‘不保存关闭ActiveWorkbook.Close savechanges:=true ‘保存关闭set rrr = CreateObject("Scripting.FileSystemObject") ‘sub SHEET ,range Set r = rrr.GetFolder("D:\EXCEL练习")Application.ScreenUpdating = FalseFor Each i In r.FilesWorkbooks.Open Filename:=("D:\EXCEL练习\" + + "") ‘+=& Sheets(1).SelectRange("d2").SelectActiveCell.FormulaR1C1 = "11"ActiveWorkbook.Close savechanges:=trueNextApplication.ScreenUpdating = True ‘End SubDim wjm ‘Sub dir用法wjm = Dir("D:\EXCEL练习\*.xls")MsgBox wjmDo While wjm <> "" '当指定路径中有文件时进行循环MsgBox wjmwjm = Dir: '找寻下一个*.xls文件Loop‘End Sub dir用法Dim MyPath$, MyName$, sh As Worksheet, arr ‘SUB能用原版Set sh = ActiveSheetMyPath = ThisWorkbook.Path & "\"MyName = Dir(MyPath & "*.xls")Application.ScreenUpdating = False[a1].CurrentRegion.Offset(2).ClearContentsDo While MyName <> ""If MyName <> ThenWith GetObject(MyPath & MyName).Close FalseEnd WithEnd IfMyName = DirLoopApplication.ScreenUpdating = TrueMsgBox "ok" ‘end sub能用原版Dim MyPath$, MyName$, sh As Worksheet, arr ‘sub能用改版MyPath =("D:\EXCEL练习\")‘MyPath = ThisWorkbook.Path & "\"MyName = Dir(MyPath & "*.xls")Application.ScreenUpdating = FalseDo While MyName <> ""‘If MyName <> ThenWith GetObject(MyPath & MyName) ‘ Workbooks.Open (MyPath & MyName).Sheets(1).Cells(2,7 )=MyPath & MyName ‘Sheets(1).Cells(2,7 )=“1”Windows(MyName).Visible = True.Close savechanges:=True ‘ActiveWorkbook.Close savechanges:=trueEnd WithEnd IfMyName = DirLoopApplication.ScreenUpdating = TrueMsgBox "ok" ‘End Sub能用改版Dim MyPath$, MyName$, sh As Worksheet, a as Integer ‘sub写入所有文件全名 MyPath =("D:\EXCEL练习\")‘MyPath = ThisWorkbook.Path & "\"MyName = Dir(MyPath & "*.xls")Application.ScreenUpdating = Falsea=1Do While MyName <> ""If MyName <> ThenWith GetObject(MyPath & MyName) ‘ Workbooks.Open (MyPath & MyName).Sheets(1).Cells(2,7 )=MyPath & MyName ‘Sheets(1).Cells(2,7 )=“1”ActiveWorkbook.Sheets(1).Cells(a,1 )= MyPath & MyNameWindows(MyName).Visible = True.Close savechanges:=True ‘ActiveWorkbook.Close savechanges:=trueEnd Witha=a+1End IfMyName = DirLoopApplication.ScreenUpdating = TrueMsgBox "ok" ’End Sub 写入所有文件全名Dim Mypath As String ‘SUB写入到A:ADim Myname As StringDim arr(1 To 1000, 1 To 1) As StringDim k As IntegerMypath = ("D:\EXCEL练习\")Myname = dir(Mypath & "*.xls")Do While Myname <> ""k = k + 1arr(k, 1) = MynameMyname = dirLoopColumns("A:A").ClearCells(1, 1).Resize(UBound(arr), 1) = arrMsgBox "ok" ‘ENDSUB写入到A:ASub Workbooks("book").Activate ‘Windows("TPM date2.xls").Close ‘ End sub sub ActiveWindow.Visible = False Workbooks("book").Windows（1）.Visible=False ‘End subDim MyFile, MyPath, MyName‘sub dir' 返回“WIN.INI” （如果该文件存在）。
用VBA实现自动打印指定文件夹中所有文件指定区域的内容
用VBA实现自动打印指定文件夹中所有文件指定区域的内容要用VBA实现自动打印指定文件夹中所有Excel文件的第一个工作表中A3:E10区域的内容，你可以创建一个宏，该宏会遍历指定文件夹中的所有Excel文件，打开每个文件，设置打印区域，然后打印该区域。
以下是实现这一目标的VBA代码示例：Sub PrintAllSheetsInFolder()Dim FolderPath As StringDim FileList As VariantDim i As LongDim wb As WorkbookDim ws As Worksheet设置文件夹路径FolderPath="C:\Your\Folder\Path\"更改此路径以匹配你的文件夹位置获取文件夹中所有.xls和.xlsx文件的列表FileList=Dir(FolderPath&"*.xls*",vbNormal)遍历文件列表Do While FileList<>""Set wb=Workbooks.Open(FolderPath&FileList)选择第一个工作表Set ws=wb.Sheets(1)设置打印区域ws.PageSetup.PrintArea="$A$3:$E$10"打印工作表ws.PrintOut Copies:=1关闭工作簿，不保存更改wb.Close SaveChanges:=False获取下一个文件FileList=Dir()LoopMsgBox"Printing completed."End Sub在这段代码中：`FolderPath`变量应更改为包含Excel文件的文件夹路径。
`FileList`使用`Dir`函数来获取文件夹中所有`.xls`和`.xlsx`文件的列表。
`Do While`循环遍历文件列表并打开每个工作簿。
[转载]实战：ExcelVBA实现读取指定文件夹下全部文件名与文件夹名
![[转载]实战：ExcelVBA实现读取指定文件夹下全部文件名与文件夹名](https://img.taocdn.com/s3/m/79343994690203d8ce2f0066f5335a8102d266a1.png)
[转载]实战：ExcelVBA实现读取指定文件夹下全部文件名与文件夹名在管理公私文件时总是喜欢随处乱放，找寻起来只能利用Microsoft的搜索功能了，而有时因为忘记了文件名甚至找都找不到，那种强迫感很恐怖的。
首先看一下结果：程序帮助调取了指定文件夹下面所有的文件名、文件后缀、文件路径、文件夹名等等，如果您也写过VBA程序，那么相信还会发挥您的所长加入文件大小、文件创建日期等等属性丰富这个程序的。
这个程序涉及了4个子程序:•jove_loop_total: 总程序•jove_loop_step1：清楚原有格式、加入标题行并调用下一个程序•OkExcel(sPath As String)：读取文件与文件夹信息•jove_loop_step2：循环读取文件夹属性的那些字段，并读取其内部的文件们 --- 类似蜘蛛爬宏程序源码：Sub jove_loop_total()'D盘下全部文件夹及文件读取用插件Call jove_loop_step1Call jove_loop_step2MsgBox "Done"End SubSub jove_loop_step1()'加上标题行Columns("A:C").ClearCells(1, 1) = "文件名"Cells(1, 2) = "类型"Cells(1, 3) = "所在位置"Dim jove_address As Stringjove_address = ThisWorkbook.PathCall OkExcel(jove_address & "")End SubSub OkExcel(sPath As String)Dim i As LongDim sTxt As Stringi = Range("A65535").End(xlUp).RowsTxt = Dir(sPath, 31)Do While sTxt <> ""On Error Resume NextIf sTxt <> And sTxt <> "." And sTxt <> ".." And sTxt <> "081226" Then '忽略哪些隐藏系统文件夹i = i + 1Cells(i, 1) = "'" & sTxtIf (GetAttr(sPath & sTxt) And vbDirectory) = vbDirectory Then'如果是文件夹Cells(i, 2) = "文件夹"Cells(i, 3) = sPath & sTxt & ""Cells(i, 1).Hyperlinks.Add Anchor:=Selection, Address:=Cells(i, 3)Else '如果是文件Cells(i, 2) = "文件"Cells(i, 3) = sPath & sTxtCells(i, 1).Hyperlinks.Add Anchor:=Selection, Address:=Cells(i, 3)End IfEnd IfsTxt = DirLoopEnd SubSub jove_loop_step2()For i = 2 To 65535On Error Resume NextIf Cells(i, 2) = "文件夹" And Cells(i, 1) <> "Foxmail" And Cells(i, 1) <> "RECYCLER" And Cells(i, 1) <> "System Volume Information" And Cells(i, 1) <> "mail" Then '忽略哪些隐藏系统文件夹Call OkExcel(Cells(i, 3))End IfNextEnd Sub。
用VBA提取路径下所有工作簿的工作表名（四个方法）
用VBA提取路径下所有工作簿的工作表名（四个方法）方法一：Open方法思路：遍历路径下的工作簿并用Workbooks.Open打开，再遍历工作表名Workbooks.Open打开一个工作簿。
语法表达式.Open(FileName, UpdateLinks, ReadOnly, Format, Password, WriteResPassword, IgnoreReadOnlyRecommended, Origin, Delimiter, Editable, Notify, Converter, AddToMru, Local, CorruptLoad)表达式一个代表 Workbooks 对象的变量。
方法二：GetObject方法思路：遍历路径下的工作簿并使用GetObject函数访问文件，再获取工作表名GetObject返回文件中的ActiveX 对象的引用。
语法GetObject([pathname] [, class])方法三：OpenSchema 方法思路：遍历路径下的工作簿并使用ADO访问文件，再用OpenSchema 获取工作表名PS：使用ADO查询大量工作簿速度较快，但ADO对字段、数据类型等要求较严格，而且ADO取得的工作表名与工作表真实的排序没有关系OpenSchema 方法从提供者获取数据库模式信息。
语法Set recordset = connection.OpenSchema (QueryType, Criteria, SchemaID)querytype 所要运行的模式查询类型Set recordset = connection.OpenSchema (adSchemaTables) 创建数据表记录集方法四：ADOX.Catalog 方法思路：遍历路径下的工作簿调用的是ADOX.Catalog组件访问文件，再遍历对象Table获取工作表名 For Each MyTable In T ables ADOX.CatalogMicrosoft? ActiveX? Data Objects Extensions for Data Definition Language and Security (ADOX) 是对 ADO 对象和编程模型的扩展。
VBA读取文件夹下所有文件夹及文件内容，并以树形结构展示
VBA读取⽂件夹下所有⽂件夹及⽂件内容，并以树形结构展⽰Const TR_LEVEL_MARK = "+"Const TR_COL_INDEX = "A"Const TR_COL_LEVEL = "E"Const TR_COL_NAME = "C"Const TR_COL_COUNT = "D"Const TR_COL_TREE_START = "F"Const TR_ROW_HEIGHT = 23Const TR_COL_LINE_WIDTH = 3Const TR_COL_BOX_MARGIN = 4Sub getpath()Dim obj As Object, i&, arrf$(), mf&, n$(), d As ObjectRange("A2:C1000").ClearContents '清空A2：C1000列On Error Resume NextDim shell As VariantSet shell = CreateObject("Shell.Application")Set filePath = shell.BrowseForFolder(&O0, "选择⽂件夹", &H1 + &H10, "") '获取⽂件夹路径地址⼿动选择Set shell = NothingIf filePath Is Nothing Then '检测是否获得有效路径，如取消直接跳出程序Exit SubElsegg = filePath.Items.Item.PathEnd IfSet obj = CreateObject("Scripting.FileSystemObject") '定义变量Call GetFolders(gg, obj, arrf, mf, n) '获取路径m = -1With ActiveSheetFor i = 1 To mfm = m + 1Cells(m + 1, 1) = arrf(i)Cells(m + 1, 5) = ""For j = 1 To n(i)Cells(m + 1, 5) = "+" & Cells(m + 1, 5)Level = Cells(m + 1, 5)NextSet fld = obj.getfolder(arrf(i))For Each ff In fld.Files '遍历⽂件夹⾥⽂件m = m + 1Cells(m + 1, 1) = Cells(m + 1, 2) = ff.PathCells(m + 1, 3) = ff.SizeCells(m + 1, 4) = ff.DateCreatedCells(m + 1, 5) = Level & "+"NextNextEnd WithCall CalculationAndDrawTreeEnd SubPrivate Sub GetFolders(ByVal sPath$, Fso As Object, ByRef arrf$(), ByRef mf&, ByRef n$())Dim SubFolder As Objectmf = mf + 1ReDim Preserve arrf(1 To mf)arrf(mf) = sPathReDim Preserve n(1 To mf)n(mf) = mfFor Each SubFolder In Fso.getfolder(sPath).SubFoldersCall GetFolders(SubFolder.Path, Fso, arrf, mf, n)NextSet SubFolder = NothingEnd Sub'=============================================================================== ' 堆栈在树形结构中使⽤的实例''-------------------------------------------------------------------------------' 本实例实现⼀下功能：' (1) 树形结构中，按级数汇总数量，即每级汇总该级下全部数量' (2) 按树形结构设置Excel的数据分组及分级显⽰' (3) 使⽤⽅框与连接线绘制树形，类似TreeView效果'-------------------------------------------------------------------------------' 原始数据中，有全部数形结构数据，各节点唯⼀的编号、能指⽰节点所在级数的符号、' 节点的名称、需要统计的数量。
Excel VbA 读取某个文件夹下所有文件的内容
Excel VbA 读取某个文件夹下所有文件的内容Sub GetAFolderMoreWorkBooks()Dim fPath As String ‘路径名Dim fName As String ‘文件名Dim sName As String ‘工作表名称Dim cellRange As String ‘单元格范围Dim fNameCount As Integer ‘文件数目Dim fNameList() As String ‘文件名列表Dim rValue As Variant ‘某个单元格中的值Dim j As IntegerDim oldCol As Integer ‘文件夹下表格的活动单元格Dim newCol As Integer ‘新生成表格的活动单元格j = 1oldCol = 11newCol = 1fPath = "C:¥Documents and Settings¥USER¥デスクトップ¥check”sName = ”レビュー記録"fName = Dir（fPath ＆”¥” ＆”*.xls”)While fName 〈> ””‘获取该文件夹下所有表格的名字fNameCount = fNameCount + 1ReDim Preserve fNameList(1 To fNameCount)fNameList(fNameCount）= fNamefName = DirWendWorkbooks.AddIf fNameCount = 0 Then Exit SubrValue = 1For j = 1 To fNameCountoldCol = 11rValue = 1While rValue <〉0oldRange = ”A” & oldCol ＆”:P” ＆oldColnewRange = ”B" ＆newCol ＆”:R” & newColCells(newCol，1）.Formula = fNameList（j)’MsgBox ”fNameList：” ＆fNameList（j)If rValue 〈〉0 ThenWith ActiveSheet。
VBA遍历指定目录下的所有子文件夹和文件（DIR）
VBA遍历指定⽬录下的所有⼦⽂件夹和⽂件（DIR）给⼀个笨笨的办法，使⽤ DIR!'以查找D:\盘下所有EXCEL⽂件为例Sub M_dir()'这是⼀个主模块，中间调⽤两⼈⼦模块，⼀个遍历指定⽬录下的所有⽂件夹，⼀个遍历⽂件夹下的所有EXCEL⽂件代码Application.DisplayAlerts = FalseApplication.ScreenUpdating = FalseOn Error Resume Next = "路径"If Err.Number <> 0 ThenActiveSheet.DeleteSheets("路径").Cells.DeleteErr.Clear: On Error GoTo 0End IfSet Sh = Sheets("路径")Sh.[a1] = "D:\"'以查找D盘下所有EXCEL⽂件为例i = 1Do While Sh.Cells(i, 1) <> ""dirdir (Sh.Cells(i, 1))i = i + 1LoopOn Error Resume Next = "XLS⽂件"If Err.Number <> 0 ThenActiveSheet.DeleteSheets("XLS⽂件").Cells.DeleteErr.Clear: On Error GoTo 0End IfSet sh2 = Sheets("XLS⽂件")sh2.Cells(1, 1) = "⽂件清单"For Each cel In Sh.[a1].CurrentRegionCall dirf(cel.Value)NextEnd SubSub dirf(My_Path)'遍历⽂件夹下的所有EXCEL⽂件Set sh2 = Sheets("XLS⽂件")mm = sh2.[a65536].End(xlUp).Row + 1MyFilename = Dir(My_Path & "*.xl*")Do While MyFilename <> ""sh2.Cells(mm, 1) = My_Path & MyFilenamemm = mm + 1MyFilename = DirLoopEnd SubSub dirdir(MyPath)'遍历指定⽬录下的所有⽂件夹Dim MyNameSet Sh = Sheets("路径")MyName = Dir(MyPath, vbDirectory)m = Sh.[a65536].End(xlUp).Row + 1Do While MyName <> ""If MyName <> "." And MyName <> ".." ThenIf (GetAttr(MyPath & MyName) And vbDirectory) = vbDirectory ThenSh.Cells(m, 1) = MyPath & MyName & "\"m = m + 1End IfEnd IfMyName = DirLoopEnd Sub。
用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。
- 1、下载文档前请自行甄别文档内容的完整性，平台不提供额外的编辑、内容补充、找答案等附加服务。
- 2、"仅部分预览"的文档,不可在线预览部分如存在完整性等问题,可反馈申请退款(可完整预览的文档不适用该条件!)。
- 3、如文档侵犯您的权益，请联系客服反馈,我们会尽快为您处理(人工客服工作时间：9:00-18:30)。
最近使用VBA编程，要用到一个功能，使得Excel能够读取指定文件夹下的所有文件名称。
使用的是Excel2010版本，但是在Excel2003版本中能够使用的FileSearch在Excel2010版中会出错，因此不得不另找其它方法，下面介绍三种方法，在Excel单元格中显示特定目录下的文件名称（文件大小，日期时间等），也可以自行修改符合自己的使用要求。
在Excel2010和Excel2003版本中均测试过可行。
我工作中使用繁体，第三种方法使用的是繁体，所以在简体系统下会乱码，这个不会妨碍程序运行，gongxi1是我设置的一个窗体，可忽略。
第三种不仅仅能导入特定文件下的所有文件，也可以导入文件夹下的文件夹文件。
第一种：Sub testit()Dim k As VariantDim m As Variantm = 1myvar = FileList("C:\Users\ownding\SkyDrive\文档\工作事項")For i = LBound(myvar) To UBound(myvar)Debug.Print myvar(i)NextFor Each k In myvarSheets("sheet1").Cells(m, 1) = km = m + 1Next kEnd SubFunction FileList(fldr As String, Optional fltr As String = "*.*") As VariantDim sTemp As String, sHldr As StringIf Right$(fldr, 1) <> "" Then fldr = fldr & ""sTemp = Dir(fldr & fltr)If sTemp = "" ThenFileList = Split("No files found", "|") '确保返回数组Exit FunctionEnd IfDosHldr = DirIf sHldr = "" Then Exit DosTemp = sTemp & "|" & sHldrLoopFileList = Split(sTemp, "|")End Function-----------------------------------------------------------------------------第二种：Option ExplicitSub ListFiles()Dim Directory As StringDim r As LongDim f As StringDim FileSize As DoubleWith Application.FileDialog(msoFileDialogFolderPicker).InitialFileName = Application.DefaultFilePath & "".Title = "Select a location containing the files you want to list." .ShowIf .SelectedItems.Count = 0 ThenExit SubElseDirectory = .SelectedItems(1) & ""End IfEnd Withr = 1' 插入表头Cells.ClearContentsCells(r, 1) = "Files in " & DirectoryCells(r, 2) = "Size"Cells(r, 3) = "Date/Time"Range("A1:C1").Font.Bold = True' 获得第一个文件f = Dir(Directory, vbReadOnly + vbHidden + vbSystem)Do While f <> ""r = r + 1Cells(r, 1) = f'调整 filesize > 2 gigabytesFileSize = FileLen(Directory & f)If FileSize < 0 Then FileSize = FileSize + 4294967296#Cells(r, 2) = FileSizeCells(r, 3) = FileDateTime(Directory & f)' 获得下个文件f = DirLoopEnd Sub-----------------------------------------------------------------------------第三种：Option ExplicitSub GetAllFiles()Dim Directory As StringDim Ans As VariantDim usedtime As DoubleAns = MsgBox("琌 钡旧 ゅン 嘿 匡拒隔畖", vbYesNo + vbQuestion) '矗ㄑ匡拒ゅン の 钡旧 ゅン匡兜If Ans = vbNo ThenWith Application.FileDialog(msoFileDialogFolderPicker).InitialFileName = Application.DefaultFilePath & "".Title = "叫匡拒 ゅンЖ.".ShowIf .SelectedItems.Count = 0 ThenExit SubElseDirectory = .SelectedItems(1) & ""End IfEnd WithElseDirectory = "\\189.3.3.3\ziliao\垂 \だ摸诀计沮\etch-befor"End IfCells.ClearContentsusedtime = TimerApplication.ScreenUpdating = FalseCall RecursiveDir(Directory)'础ActiveSheet.ListObjects.Add xlSrcRange, _Range("A2").CurrentRegion, , xlYesApplication.ScreenUpdating = Trueusedtime = Format(Timer - usedtime, "00.00")gongxi1.TextBox2.Text = usedtimegongxi1.ShowEnd SubPublic Sub RecursiveDir(ByVal CurrDir As String)Dim Dirs() As StringDim NumDirs As LongDim Filename As StringDim PathAndName As StringDim i As LongDim Filesize As Double' 絋玂ゅン程 \挡ЮIf Right(CurrDir, 1) <> "" Then CurrDir = CurrDir & ""' 讽玡 い材 ︽结Cells(2, 1) = "ゅン隔畖 "Cells(2, 2) = "ゅン 嘿 "Cells(2, 3) = " "Cells(2, 4) = "ら戳/ 丁"Cells(2, 5) = "赣 虫琌 穨"Range("A1:E2").Font.Bold = True' 莉眔ゅンOn Error Resume NextFilename = Dir(CurrDir & "*.*", vbDirectory)Do While Len(Filename) <> 0If Left(Filename, 1) <> "." Then '讽玡 dirPathAndName = CurrDir & FilenameIf (GetAttr(PathAndName) And vbDirectory) = vbDirectory Then' 纗т 隔畖ReDim Preserve Dirs(0 To NumDirs) As StringDirs(NumDirs) = PathAndNameNumDirs = NumDirs + 1Else'盢隔畖㎝ 嘿糶Cells(WorksheetFunction.CountA(Range("A:A")) + 2, 1) = CurrDirCells(WorksheetFunction.CountA(Range("B:B")) + 2, 2) = Filename'秸俱ゅンFilesize = FileLen(PathAndName)If Filesize < 0 Then Filesize = Filesize + 4294967296#Cells(WorksheetFunction.CountA(Range("C:C")) + 2, 3) = FilesizeCells(WorksheetFunction.CountA(Range("D:D")) + 2, 4) = FileDateTime(PathAndName) End IfEnd IfFilename = Dir()Loop' 矪瞶т ゅンFor i = 0 To NumDirs - 1RecursiveDir Dirs(i)Next iEnd Sub。