本文目录一览：
- 1、VBA获取某文件夹下所有文件和子文件目录的文件
- 2、vba读取文件夹中的文件名
- 3、如何使用excel提取文件夹中的所有文件名称？
- 4、用EXCEL VBA获取指定目录下的文件名(包括文件夹名)
- 5、excel怎样用vba自动提取文件夹内的文件名
- 6、EXCEL vba 读取指定文件夹的名字和循环打开文件夹
VBA获取某文件夹下所有文件和子文件目录的文件
【引用位置】
'-------------------------------------------
'获取某文件夹下的所有Excel文件
'-------------------------------------------
Sub getExcelFile(sFolderPath As String)
On Error Resume Next
Dim f As String
Dim file() As String
Dim x
k = 1
ReDim file(1)
file(1) = sFolderPath ""
End Sub
'-------------------------------------------
'获取某文件夹下的所有文件和子目录下的文件
'-------------------------------------------
Sub getAllFile(sFolderPath As String)
'Columns(1).Delete
On Error Resume Next
Dim f As String
Dim file() As String
Dim i, k, x
x = 1
i = 1
k = 1
ReDim file(1 To i)
file(1) = sFolderPath ""
'-- 获得所有子目录
Do Until i k
f = Dir(file(i), vbDirectory)
Do Until f = ""
If InStr(f, ".") = 0 Then
k = k + 1
ReDim Preserve file(1 To k)
file(k) = file(i) f ""
End If
f = Dir
Loop
i = i + 1
Loop
'-- 获得所有子目录下的所有文件
For i = 1 To k
f = Dir(file(i) " . ") '通配符 . 表示所有文件，*.xlsx Excel文件
Do Until f = ""
'Range("a" x) = f
Range("a" x).Hyperlinks.Add Anchor:=Range("a" x), Address:=file(i) f, TextToDisplay:=f
x = x + 1
f = Dir
Loop
Next
End Sub
vba读取文件夹中的文件名
提取当前文件夹下的文件名称并放在A列
Sub 按钮1_Click()
Application.ScreenUpdating = False
Set fso = CreateObject("scripting.filesystemobject")
Set ff = fso.getfolder(ThisWorkbook.Path) 'ThisWorkbook.Path是当前代码文件所在路径，路径名可以根据需求修改
ActiveSheet.UsedRange.ClearContents
a = 1
For Each f In ff.Files
Rem 如果不需要提取本代码文件名，可以增加if语句 if f.name thisworkbook.name then.....
Rem 如果值需要提取某类文件，需要对f.name的扩展名进行判断
Rem 个人感觉split取 扩展名：split（f.name,".")(ubound（split（f.name,".")）)，然后再判断，避免文件名还有其他“.”
Cells(a, 1) = f.Name '相对路径名
Cells(a, 2) = f '全路径名
a = a + 1
Next f
Application.ScreenUpdating = True
End Sub
如何使用excel提取文件夹中的所有文件名称？
使用excel提取文件夹中的所有文件名称的方法主要有以下两个：\x0d\x0a1、在那个文件夹内新建一个.TXT文件（如wenjian.txt），用记事本单开输入\x0d\x0adir 1.txt\x0d\x0a保存退出\x0d\x0a将刚才的.TXT（wenjian.txt）更名为.bat文件（wenjian.bat）\x0d\x0a双击wenjian.bat文件运行一次，在文件夹内多出一个1.txt文件\x0d\x0a打开1.txt文件，将其中的内容粘贴到Excel中，数据——分列处理就可以得到你要的文件名列表了！\x0d\x0a2、VBA（2003版）\x0d\x0a在那个文件夹下新建Excel文件，打开新建的Excel文件，右击工作表标签（如Sheet1），查看代码——在代码编辑器中输入以下代码\x0d\x0aSub Test()\x0d\x0aDim i As Integer\x0d\x0aDim strPath As String\x0d\x0astrPath = ThisWorkbook.Path\x0d\x0aWith Application.FileSearch\x0d\x0a .LookIn = strPath\x0d\x0a .SearchSubFolders = True\x0d\x0a .Filename = "*.*"\x0d\x0a If .Execute 0 Then\x0d\x0a For i = 1 To .FoundFiles.Count\x0d\x0a Range("A" i) = .FoundFiles(i)\x0d\x0a Next i\x0d\x0a End If\x0d\x0aEnd With\x0d\x0aEnd Sub\x0d\x0a回到Excel表格中，工具——宏——宏——选择Sheet1.Test——执行\x0d\x0a\x0d\x0a方法一简单的操作就可以，方法二需要对程序有一定的了解，方法二通用性比较强，需要的时候执行一下就可以，更快捷。-vba提取文件夹下的文件夹名称
用EXCEL VBA获取指定目录下的文件名(包括文件夹名)
1.点开始菜单，就能看到上面的界面，选择“运行”！点了运行程序后，在里面输入“cmd”点击确定会进入命令提示符串口。
2.打个比方说，文件在C盘里面的111文件夹，要读取里面的文件的文件名字。
3.利用cd命令到达要读取文件名的文件夹，用法是这样的：命令为“cd c:\111”。
4.然后会看到下面的这个情况：
5.然后输入命令“dir /bd:1.xls”然后回车。
6.到D盘就能看到一个名称为1.xls的文件。
7.打开就是了。
excel怎样用vba自动提取文件夹内的文件名
excel中用vba实现自动提取文件夹内的文件名的方法如下：
1、新建一个vba宏脚本
2、写入如下代码：
Function GetFileList(FileSpec As String) As Variant
' Returns an array of filenames that match FileSpec
' If no matching files are found, it returns False
Dim FileArray() As Variant
Dim FileCount As Integer
Dim FileName As String
On Error GoTo NoFilesFound
FileCount = 0
FileName = Dir(FileSpec)
If FileName = "" Then GoTo NoFilesFound
' Loop until no more matching files are found
Do While FileName ""
FileCount = FileCount + 1
ReDim Preserve FileArray(1 To FileCount)
FileArray(FileCount) = FileName
FileName = Dir()
Loop
GetFileList = FileArray
Exit Function
' Error handler
NoFilesFound:
GetFileList = False
End Function
3、传入文件路径就可以获取文件名到指定的excel表格中
4、结果：
EXCEL vba 读取指定文件夹的名字和循环打开文件夹
'------------------------------------------------------------------------------
'
' Form Code
'
'------------------------------------------------------------------------------
Option Explicit
Private row As Integer, col As Integer
Private Sub CloseWindows_Click()
If TextStartRow.Text = "" Then TextStartRow = 0
If TextStartCol = "" Then TextStartCol = 0
If TextPath = "" Then TextPath = "D:\"
CloseMyDialog TextStartRow, TextStartCol
End Sub
Private Sub GetDir_Click()
If TextStartRow.Text = "" Then TextStartRow = 0
If TextStartCol = "" Then TextStartCol = 0
If TextPath = "" Then
TextPath = "D:\"
ElseIf Right(TextPath, 1) "\" Then
TextPath = TextPath "\"
End If
doGetDir TextPath, Val(TextStartRow), Val(TextStartCol)
End Sub
Private Sub ShowWindows_Click()
If TextStartRow.Text = "" Then TextStartRow = 0
If TextStartCol = "" Then TextStartCol = 0
If TextPath = "" Then TextPath = "D:\"
ShowMyDialog Application.hWnd, TextStartRow, TextStartCol
End Sub
上面是Form上面的
Option Explicit
Dim MyFile, Mypath, MyName
Dim i%, j%
Dim DirPath() As String
Sub GetDir(ByVal Mypath As String, row As Integer, col As Integer)
' 显示 C:\ 目录下的名称。
' MyPath = "d:\电大\" ' 指定路径。
MyName = Dir(Mypath, vbDirectory) ' 找寻第一项。
Do While MyName "" ' 开始循环。
' 跳过当前的目录及上层目录。
If MyName "." And MyName ".." Then
' 使用位比较来确定 MyName 代表一目录。
If (GetAttr(Mypath MyName) And vbDirectory) = vbDirectory Then
Cells(row + i, col) = Mypath MyName ' 如果它是一个目录，将其名称显示出来。
ReDim Preserve DirPath(i)
DirPath(i) = Mypath MyName "\"
i = i + 1
End If
End If
MyName = Dir ' 查找下一个目录。
Loop
End Sub
Public Sub doGetDir(ByVal TextPath$, ByVal TextStartRow%, ByVal TextStartCol%)
j = 1
i = 1
Mypath = TextPath
GetDir Mypath, TextStartRow, TextStartCol
For j = 1 To i - 1
GetDir DirPath(j), TextStartRow, TextStartCol
Next
End Sub
'end code---------------------------------------------------
Option Explicit
Public Const OFN_ALLOWMULTISELECT As Long = H200
Public Const OFN_CREATEPROMPT As Long = H2000
Public Const OFN_ENABLEHOOK As Long = H20
Public Const OFN_ENABLETEMPLATE As Long = H40
Public Const OFN_ENABLETEMPLATEHANDLE As Long = H80
Public Const OFN_EXPLORER As Long = H80000
Public Const OFN_EXTENSIONDIFFERENT As Long = H400
Public Const OFN_FILEMUSTEXIST As Long = H1000
Public Const OFN_HIDEREADONLY As Long = H4
Public Const OFN_LONGNAMES As Long = H200000
Public Const OFN_NOCHANGEDIR As Long = H8
Public Const OFN_NODEREFERENCELINKS As Long = H100000
Public Const OFN_NOLONGNAMES As Long = H40000
Public Const OFN_NONETWORKBUTTON As Long = H20000
Public Const OFN_NOREADONLYRETURN As Long = H8000 '*see comments
Public Const OFN_NOTESTFILECREATE As Long = H10000
Public Const OFN_NOVALIDATE As Long = H100
Public Const OFN_OVERWRITEPROMPT As Long = H2
Public Const OFN_PATHMUSTEXIST As Long = H800
Public Const OFN_READONLY As Long = H1
Public Const OFN_SHAREAWARE As Long = H4000
Public Const OFN_SHAREFALLTHROUGH As Long = 2
Public Const OFN_SHAREWARN As Long = 0
Public Const OFN_SHARENOWARN As Long = 1
Public Const OFN_SHOWHELP As Long = H10
Public Const OFS_MAXPATHNAME As Long = 260
Public Const OFS_FILE_OPEN_FLAGS = OFN_EXPLORER _
Or OFN_LONGNAMES _
Or OFN_CREATEPROMPT _
Or OFN_NODEREFERENCELINKS
Public Const OFS_FILE_SAVE_FLAGS = OFN_EXPLORER _
Or OFN_LONGNAMES _
Or OFN_OVERWRITEPROMPT _
Or OFN_HIDEREADONLY
Public Type OPENFILENAME
nStructSize As Long
hWndOwner As Long
hInstance As Long
sFilter As String
sCustomFilter As String
nMaxCustFilter As Long
nFilterIndex As Long
sFile As String
nMaxFile As Long
sFileTitle As String
nMaxTitle As Long
sInitialDir As String
sDialogTitle As String
flags As Long
nFileOffset As Integer
nFileExtension As Integer
sDefFileExt As String
nCustData As Long
fnHook As Long
sTemplateName As String
End Type
Public OFN As OPENFILENAME
Public Const WM_CLOSE = H10
Public Declare Function GetOpenFileName Lib "comdlg32" _
Alias "GetOpenFileNameA" _
(pOpenfilename As OPENFILENAME) As Long
Public Declare Function GetSaveFileName Lib "comdlg32" _
Alias "GetSaveFileNameA" _
(pOpenfilename As OPENFILENAME) As Long
Public Declare Function GetShortPathName Lib "kernel32" _
Alias "GetShortPathNameA" _
(ByVal lpszLongPath As String, _
ByVal lpszShortPath As String, _
ByVal cchBuffer As Long) As Long
Public Const WM_INITDIALOG = H110
Private Const SW_SHOWNORMAL = 1
Public Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Public Declare Function GetParent Lib "user32" _
(ByVal hWnd As Long) As Long
Public Declare Function SetWindowText Lib "user32" _
Alias "SetWindowTextA" _
(ByVal hWnd As Long, _
ByVal lpString As String) As Long
Public Declare Function MoveWindow Lib "user32" _
(ByVal hWnd As Long, _
ByVal x As Long, _
ByVal y As Long, _
ByVal nWidth As Long, _
ByVal nHeight As Long, _
ByVal bRepaint As Long) As Long
Public Declare Function GetWindowRect Lib "user32" _
(ByVal hWnd As Long, _
lpRect As RECT) As Long
Public Declare Function SendMessage Lib "user32" _
Alias "SendMessageA" _
(ByVal hWnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
lParam As Any) As Long
Public Declare Function FindWindow Lib "user32" _
Alias "FindWindowA" _
(ByVal lpClassName As Long, _
ByVal lpWindowName As String) As Long
Public Function FARPROC(ByVal pfn As Long) As Long
FARPROC = pfn
End Function
Public Function OFNHookProc(ByVal hWnd As Long, _
ByVal uMsg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long
Dim hwndParent As Long
Dim rc As RECT
Dim newLeft As Long
Dim newTop As Long
Dim dlgWidth As Long
Dim dlgHeight As Long
Dim scrWidth As Long
Dim scrHeight As Long
Select Case uMsg
Case WM_INITDIALOG
hwndParent = GetParent(hWnd)
If hwndParent 0 Then
Call GetWindowRect(hwndParent, rc)
dlgWidth = rc.Right - rc.Left
dlgHeight = rc.Bottom - rc.Top
Call MoveWindow(hwndParent, newLeft, newTop, dlgWidth, dlgHeight, True)
OFNHookProc = 1
End If
Case Else:
End Select
End Function
Public Sub ShowFolder(hWnd As Long, Mypath$)
Dim sFilters As String
Dim pos As Long
Dim buff As String
Dim sLongname As String
Dim sShortname As String
With OFN
.nStructSize = Len(OFN)
.hWndOwner = hWnd
.sFilter = sFilters
.nFilterIndex = 2
.sFile = Space$(1024) vbNullChar vbNullChar
.nMaxFile = Len(.sFile)
.sDefFileExt = "bas" vbNullChar vbNullChar
.sFileTitle = vbNullChar Space$(512) vbNullChar vbNullChar
.nMaxTitle = Len(OFN.sFileTitle)
.sInitialDir = Mypath vbNullChar vbNullChar
.sDialogTitle = Mypath vbNullChar vbNullChar
.flags = OFS_FILE_OPEN_FLAGS Or _
OFN_ALLOWMULTISELECT Or _
OFN_EXPLORER Or _
OFN_ENABLEHOOK
.fnHook = FARPROC(AddressOf OFNHookProc)
End With
GetOpenFileName OFN
End Sub
Public Sub CloseFolder(Mypath As String)
Dim hWnd As Long
hWnd = FindWindow(0, Mypath)
Call SendMessage(hWnd, WM_CLOSE, 0, ByVal 0)
End Sub
Public Sub ShowMyDialog(MyhWnd As Long, TextStartRow As Integer, TextStartCol As Integer)
Dim row, col
Dim i
Dim hWnd As Long
hWnd = MyhWnd
i = 1: row = TextStartRow: col = TextStartCol
Do While Cells(i + row, col) ""
Shell "C:\Windows\explorer.exe " Cells(i + row, col)
' ShowFolder hWnd, Cells(i + row, col)
' hWnd = FindWindow(0, Cells(i + row, col))
i = i + 1
Loop
End Sub
Public Sub CloseMyDialog(TextStartRow As Integer, TextStartCol As Integer)
Dim row, col
Dim i
i = 1: row = TextStartRow: col = TextStartCol
Do While Cells(i + row, col) ""
CloseFolder pathToName(Cells(i + row, col))
i = i + 1
Loop
End Sub
Private Function pathToName(Mypath$) As String
Dim str() As String
str = Split(Mypath, "\")
pathToName = str(UBound(str))
End Function
