VBA输出指定文件夹下的所有文件的名称

合集下载

VBA自动生成文件名和路径的技巧

VBA自动生成文件名和路径的技巧VBA是Visual Basic for Applications的缩写，是一种用于Microsoft Office套件中自动化任务的编程语言。

在Excel、Word等应用程序中，VBA可以帮助用户完成各种繁琐的操作。

本文将介绍几种VBA自动生成文件名和路径的技巧，帮助您更高效地处理文件操作。

1. 获取当前文件名和路径在VBA中，可以使用特定的函数获取当前文件的文件名和路径。

例如，在Excel中，可以使用以下代码获取当前文件的文件名：```Dim fileName As StringfileName = ```同样地，可以使用以下代码获取当前文件的路径：```Dim filePath As StringfilePath = ThisWorkbook.Path```这样，您就可以在编写VBA代码时，动态地获取当前文件的文件名和路径。

2. 自动生成带有日期时间的文件名在某些情况下，我们需要生成带有日期时间的文件名，以便更好地组织和区分文件。

VBA提供了多种函数来获取当前日期和时间，并将其格式化为需要的字符串。

以下是一个示例代码，生成带有日期时间的文件名：```Dim fileName As StringfileName = "Report_" & Format(Now, "yyyymmdd_hhmmss") & ".xlsx" ```上述代码将生成一个类似于“Report_20220330_154500.xlsx”的文件名，其中日期时间部分表示当前的年月日时分秒。

3. 自动生成基于单元格数据的文件名有时，我们需要根据特定单元格的数据生成文件名。

例如，在Excel中，我们可以根据A1单元格的值来生成文件名，并将其赋给变量。

以下是一个示例代码：```Dim fileName As StringfileName = Range("A1").Value & ".xlsx"```上述代码将获取A1单元格的值，并将其作为文件名。

vba获取文件夹下所有文件名

vba获取⽂件夹下所有⽂件名学习⾃杨洋⽼师《全民⼀起VBA》1. 在VBA中，dir函数可以返回⼀个⽂件夹下⼀个⽂件的名字（包含后缀）。

⽰例代码：filename = Dir("F:userdataDesktop新建⽂件夹")dir后⾯的参数应该以反斜杠“”结尾，这样才能返回该⽂件夹下的⽂件名称。

否则“新建⽂件夹”会被当成⼀个⽂件名进⾏处理。

Dir运⾏⼀次只能得到⼀个⽂件名。

为得到下⼀个⽂件名，代码应该这样写：filename = Dir。

Dir后⾯不写任何参数，如果写了与前⾯相同的参数"F:userdataDesktop新建⽂件夹"，则会重新扫描该⽂件夹，⼜得到第⼀个⽂件名，如果更改为其他⽂件夹，就扫描该⽂件夹，得到它的第⼀个⽂件名如果⽂件夹中有n个⽂件，或者说有n个符合条件的⽂件，那么当Dir运⾏第n+1次时，则返回⼀个空字符串，代表已经查找完所有的⽂件。

Dir运⾏第n+2次时，程序将报错。

2. 扫描⼀个⽂件夹下所有⽂件的通⽤模板1.Dim filename as string2.filename = Dir("F:userdataDesktop新建⽂件夹") '可以更改为任意⽂件夹3.Do while filename <> ""4.相关操作5.filename = Dir '获取下⼀个⽂件名6.Loop3. Dir扫描符合条件的⽂件名（通配符*）⽰例代码：F = Dir("F:userdataDesktop新建⽂件夹*.xls")，扫描所有后缀为.xls的⽂件。

4. 判断⼀个⽂件是否存在⽰例代码：F = Dir("F:userdataDesktop新建⽂件夹123.xls")如果⽂件123.xls存在，则返回字符串123.xls，如果不存在，则返回空字符串。

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。

每日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实现自动打印指定文件夹中所有文件指定区域的内容

用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`循环遍历文件列表并打开每个工作簿。

(完整word版)VB如何获取某文件夹中所有文件的文件名

1VB如何获取某文件夹中所有文件的文件名发布时间：2009—08—31 11:02:11 查看：509次字体：【大中小】法1 filelist控件在窗体中添加drive控件、dir控件和filelist控件，然后在窗体加入如下代码：’*＊*＊＊＊**＊*＊***＊*＊＊**＊＊*＊*＊＊*＊*＊**＊＊*＊*＊＊*＊＊＊****＊**＊＊＊＊*＊’ Get the path of the dwg files'*＊*＊*＊***＊＊**＊＊＊＊***＊*＊*＊*＊＊*＊**＊＊＊＊**＊****＊*＊**＊*****＊＊* Private Sub Dir1_Change（）File1.Path = Dir1。

PathEnd Sub’*＊**＊**＊*＊*＊********＊＊＊＊*＊＊＊***＊*＊**＊＊*****＊***＊＊＊＊***＊**' Get the path which contains the dwg files'＊＊＊**＊＊*＊＊**＊*＊*＊＊＊***＊＊＊**＊**＊*＊＊＊＊＊＊**＊＊＊＊＊****＊*＊*＊*＊＊Private Sub Drive1_Change（）On Error GoTo driveerrorDir1。

Path = Drive1。

DriveExit Subdriveerror:MsgBox "驱动器错误!"， vbExclamation， "Error"’Drive1。

Drive = Dir1。

PathEnd SubPrivate Sub Form_Load（)File1.Pattern = "＊。

dwg"'File1。

Visible = FalseEnd Sub上例只筛选*。

dwg的文件，你要是想要得到多有文件名<不含子文件夹>可以设为＊。

*这样用File1.Tiem可得到那些文件名了。

VBA常用代码：批量获取指定文件夹下的文件名

VBA常⽤代码：批量获取指定⽂件夹下的⽂件名哈喽⼩伙伴们好，我是⼈见⼈爱的男神星光。

今天说说如何获取指定⽂件夹下⽂件的名称。

很久以前我们分享过DOS的⽅法，操作动画如下：VBA可以通过Wscript.Shell调⽤DOS语句，以后我们可能会分享到这部分内容~所以这⾥先简单说下动画中DOS语句的意思DIR *.*/B>LIST.TXTDIR可以简单理解成函数。

*.* *是通配符，第⼀个*是⽂件名，第⼆个*是⽂件格式。

如果只要excel⽂件，就修改为*.xls。

/b 是使⽤空格式，没有标题信息之类的。

list.txt是⽣成的⽂件类型和名字。

综上所述，如果是⽣成excel⽂件的⽬录，并以excel来呈现，命名为⽬录，语句就改为DIR *.xls/B >⽬录.xls..再说下VBA的⽅法，照例先上操作动画：代码的核⼼是DIR语句，注释部分业已作了解释，这⾥就不再啰嗦了。

Sub FileDir()Dim p$, f$, k&'获取⽤户选择⽂件夹的路径With Application.FileDialog(msoFileDialogFolderPicker)'选择⽂件夹.AllowMultiSelect = False'不允许多选If .Show Thenp = .SelectedItems(1)'选择的⽂件路径赋值变量PElseExit Sub'如果没有选择保存路径，则退出程序End IfEnd WithIf Right(p, 1) <> '\' Then p = p & '\'f = Dir(p & '*.*')'返回变量P路径下带任意扩展名的⽂件名。

如果超过⼀个⽂件存在，函数将返回按条件第⼀个找到的⽂件名。

'如果⼀个⽂件都没有，则f返回''[a:a].ClearContents '清空A列数据[a1] = '⽬录'k = 1 'KDo While f <> '' '如果f不等于''，则……k = k + 1 '累加KCells(k, 1) = ff = Dir' 若第⼆次调⽤ Dir 函数，但不带任何参数，则将返回同⼀⽬录下的下⼀个⽂件。

VBA-汇总“指定”文件夹下的各工作簿中指定SHEET的数据

Sub 汇总()Dim Sht As Worksheet, rng As Range, Sh As WorksheetDim Trow&, k&, arr, brr, i&, j&, book&, a&Dim p$, f$, Headr, KeystrWith Application.FileDialog(msoFileDialogFolderPicker)'取得用户选择的文件夹路径.AllowMultiSelect = FalseIf .Show Then p = .SelectedItems(1) Else Exit SubEnd WithIf Right(p, 1) <> "\" Then p = p & "\"'Keystr = InputBox("请输入需要合并的工作表所包含的关键词：", "提醒") If StrPtr(Keystr) = 0 Then Exit Sub'如果点击了inputbox的取消或者关闭按钮，则退出程序Trow = Val(InputBox("请输入标题的行数", "提醒"))If Trow < 0 Then MsgBox "标题行数不能为负数。

", 64, "警告": Exit Sub Set Sht = ActiveSheetApplication.ScreenUpdating = False '关闭屏幕更新Cells.ClearContentsCells.NumberFormat = "@"'清空当前表数据并设置为文本格式ReDim brr(1 To 200000, 1 To 2)'定义装汇总结果的数组brr，最大行数为20万行，2列是临时的'f = Dir(p & "*.xls*") '开始遍历工作簿Do While f <> ""If f <> Then '避免同名文件重复打开出错With GetObject(p & f)'以'只读'形式读取文件时，使用getobject方法会比workbooks.open稍快For Each Sh In .Worksheets '遍历表If InStr(1, , Keystr, vbTextCompare) Then'如果表中包含关键词则进行汇总(不区分关键词字母大小写）Set rng = edRangeIf rng.Count > 1 Then'如果rng的单元格数量大于1……book = book + 1 '标记一下是否首个Sheet,如果首个sheet，BOOK=1a = IIf(book = 1, 1, Trow + 1) '遍历读取arr数组时是否扣掉标题行arr = rng.Value '数据区域读入数组arrIf UBound(arr, 2) + 2 > UBound(brr, 2) Then'动态调整结果数组brr的最大列数，避免明细表列数不一的情况。

用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”，单击“运行”按钮。

用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 对象和编程模型的扩展。

[转载]实战：ExcelVBA实现读取指定文件夹下全部文件名与文件夹名

[转载]实战：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打开文件夹下所有文件

‘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” （如果该文件存在）。

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。

Excel获取指定路径的文件名vba代码

Excel获取指定路径的文件名vba代码在Excel VBA中，如果需要Excel获取指定路径的文件名以方便用户的操作体验，可通过VBAExcel获取指定路径的文件名。

Excel2003可通过VBA宏Excel获取指定路径的文件名。

Excel获取指定路径的文件名的方法：首先按“Alt+F11”组合键，Excel2003打开代码编辑器，单击“插入”菜单-“模块”，双击插入的模块，在右侧的代码窗口中输入：Sub Excel_Partner()Dim myFilename As String, myPath As StringChDir Application.DefaultFilePath '改变默认路径myPath = 'C:\' '指定的任意路径SendKeys myPath & '{TAB}' '将指定的任意路径发送到“打开”对话框myFilename = Application.GetOpenFilenameRange('A1') = myFilenameEnd Sub按F5运行键运行程序，Excel调用“打开”对话框，自动打开指定的路径。

双击指定的文件，Excel获取指定路径的文件名。

相关说明：当输入法处于中文输入法状态时，将不能打开指定的路径。

------分隔线----------------------------标签(Tag):excelexcel2007excel2010excel2013excel2003excel 技巧excel教程excel实例教程------分隔线----------------------------。

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.Range(newRange).FormulaArray = "='" & fPath & "¥[" & fNameList(j) & "]" & sName & "'!" & oldRange.Value = .ValueEnd WithEnd IfoldCol = oldCol + 1newCol = newCol + 1rValue = ExecuteExcel4Macro("'" & fPath & "¥[" & fNameList(j) & "]" & sName & "'!" & Range("a" & oldCol).Range("A1").Address(, , xlR1C1))WendNext jEnd Sub。

怎么通过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){请在这输入处理文件的方法,其它不变。