vba獲取文件夾中的子文件夾名稱

A. vba提取多層文件夾的*.xls文件,根據獲取到的文件名及路徑逐個打開*.xls文件,去判斷某幾列有多少個數據

• 一、所需DOS命令

  dir [drive:][path] /b > [drive:][path]filename

  二、應用實例

  如下圖，在D盤中，有一個名稱為「TQIPC」的文件夾，這個文件夾裡面，存放了很多的照片！

  

• 看到了沒有，文件夾中的照片名稱，自動就顯示在excel表格中了！

  該dos命令非常強大，用好dos命令，可省去我們很多的功夫。

  三、知識擴展

  下面，再給大家一個例子，即，自動根據照片(根據人物名稱)，建立文件夾。

  如果某個文件夾下面，您存放的是某些人物的照片，並且，每個人物的照片，都使用其名字來命名；這個時候，如何要自動根據人物的自動建立其對應的文件夾，也相當方便！

  操作的方法是，先根據上述的方法，獲取所有人物的照片的名稱，生成EXCEL文件；

  然後，在人物名稱列前面，插入一列，並輸入MD；

  接下來，使用查找替換功能，將excel文件中的人物名稱，去掉擴展名(只保留名字)；

  最後，將excel的內容，復制粘貼到記事本中，現在，我們就得到了形如：「MD人物名稱」這樣的命令格式了。(md 文件名稱，該命令格式，是使用來建立文件夾的命令，上述的操作，都是為此做准備！)

  將記事本文件保存成為形如：124.bat格式的文件，最後，雙擊此文件，文件夾名稱就自動建立好了！

B. Excel中VBA提取文件夾名稱的方法

文章介紹excel中使用vba提取文件名的操作步驟。根據需要自行修改vba提取文件名的路徑和存放單元格即可。
在excel中使用VBA編寫代碼，可以輕松的提取某個文件夾下面的所有文件名。
比如筆者在F盤下面建立了一個文件夾，文件夾的名稱是：office教程網，現在想將「office教程網」這個文件夾下面的所有文件名提取出來放在當前工作表的C列。
具體的vba提取文件名的操作如下：
1.按下ALT+F11，打開VBE編輯器。
2.執行「插入——模塊」，插入模塊1。

3.在右邊的代碼編輯窗口，復制下面的代碼，然後單擊「綠色箭頭」或者快捷鍵F5鍵，運行代碼。
Private Sub vba提取文件名()
Dim FileName As String
Dim i As Long
FileName = Dir("F:\office教程網\*.*")
i = 0
Range("C:C").ClearContents
Do While FileName > ""
i = i + 1
Cells(i, 3) = FileName
FileName = Dir
Loop
End Sub

4.關閉VBE窗口，回到工作表中，可以在C列看到F盤「office教程網」文件夾下面所有的文件名全部羅列在C列了。

關於上面的vba提取文件名的代碼，請在實際使用時，根據需要修改提取文件名的路徑（F:\office教程網\*.*），以及存放在C列的位置（Cells(i, 3)）。

C. excel怎樣用vba自動提取文件夾內的文件名

excel中用vba實現自動提取文件夾內的文件名的方法如下：

1、新建一個vba宏腳本

D. 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

E. EXCEL vba 讀取指定文件夾的名字和循環打開文件夾

就是遍歷文件夾嘛,關鍵代碼如下
在工程-引用里添加 microsoft scripting run time
然後用下面的兩個函數遞歸遍歷 就可以了
sub main()
Dim objFSO As Object
Dim objTemplateFolder As Object
Set objFSO = New Scripting.FileSystemObject
Set objTemplateFolder = objFSO.GetFolder(「D:\」)
getFiles objTemplateFolder
end sub

Sub getFiles(ByRef theFolder As Object)
Dim folder As Object
Dim c As New Scripting.FileSystemObject
『此處執行你的操作：打開關閉文件夾，取名字等
For Each folder In theFolder.subFolders
getFiles folder 』遞歸遍歷子文件夾
Next
End Sub

F. 用EXCEL VBA獲取指定目錄下的文件名(包括文件夾名)

1、首先利用快捷鍵「Windows鍵+R」打開「運行」窗口

G. 如何通過VBA快速尋找到文件夾及其中的子文件夾，並建立超鏈接。多謝！

Sub ABC()
Dim Sph
Sph = Dir("D:\data\*" & Cells(1, 1) & "*", 16)
If Sph = "" Then Exit Sub
Sph = "D:\data\" & Sph & "\"
Dir Sph, 16
Dir
Do
co = co + 1
sph1 = Dir()
If sph1 = "" Then Exit Do
Cells(2, co) = sph1
ActiveSheet.Hyperlinks.Add Cells(2, co), Sph & sph1
Loop
For i = 1 To co - 1
If Dir(Sph & Cells(2, i) & "\*") <> "" Then
ro = 3
Do
fi = Dir()
If fi = "" Then Exit Do
Cells(ro, i) = fi
ActiveSheet.Hyperlinks.Add Cells(ro, i), Sph & Cells(2, i) & "\" & fi
ro = ro + 1
Loop
End If
Next
End Sub

以上代碼可滿足你的要求。有問題請追問

H. 用VBA代碼如何獲得指定文件夾內的所有子文件夾名稱

Set fso=CreateObject("Scripting.FileSystemObject")
Set folder=fso.GetFolder("D:")
dim a() as string
dim b
b=1
for each thing in folder.subfolders
addfolder fso,thing,a,b
next
msgbox b

function addfolder(byref fso,byref dir,byref a,byref b)
set folder=fso.getfolder(dir)
a(b)=dir
b=b+1
For Each thing in folder.SubFolders
set folder=fso.getfolder(thing)
a(b)=thing
b=b+1
addfolder fso,thing,a,b
Next
end function

I. vba 遍歷指定文件夾（含子目錄）獲取文件名，哪種方法速度最快

Sub LoopAllExcelFilesInFolder()
Dim wb As Workbook
Dim myPath As String
Dim myFile As String
Dim myExtension As String
Dim FldrPicker As FileDialog

'這里很關鍵，決定宏執行快慢的關鍵
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual

'打開目錄選擇框
Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)

With FldrPicker
.Title = "請選擇目錄"
.AllowMultiSelect = False
If .Show <> -1 Then GoTo NextCode
myPath = .SelectedItems(1) & "\"
End With

'取消選擇
NextCode:
myPath = myPath
If myPath = "" Then GoTo ResetSettings

'指定過濾的文件後綴
myExtension = "*.xls*"

'遍歷全路徑
myFile = Dir(myPath & myExtension)

'循環處理每一個文件
Do While myFile <> ""
'打開
Set wb = Workbooks.Open(Filename:=myPath & myFile)

'確保工作簿被打開，在處理下一個文件時
DoEvents

'設置背景色
wb.Worksheets(1).Range("A1:Z1").Interior.Color = RGB(51, 98, 174)

'保存工作簿
wb.Close SaveChanges:=True

'確保工作簿被關閉，在處理下一個文件時
DoEvents

'接著處理下一個
myFile = Dir
Loop

'提示處理完成
MsgBox "處理完成!"

ResetSettings:
'恢復設置
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

End Sub

J. Excel VBA列出某文件夾下子文件夾及文件名

遍歷文件夾 並列出文件 & 文件夾 名 代碼如下：

在文件夾內 新建 個 Excel文件

Excel文件內 按 Alt+F11 視圖--代碼窗口， 把如下代碼復制進去， F5運行

Sub遍歷文件夾()
'OnErrorResumeNext
Dimfn(1To10000)AsString
Dimf,i,k,f2,f3,x
Dimarr1(1To100000,1To1)AsString,qAsInteger
Dimt
t=Timer
fn(1)=ThisWorkbook.path&""
i=1:k=1
DoWhilei<UBound(fn)
Iffn(i)=""ThenExitDo
f=Dir(fn(i),vbDirectory)
Do
IfInStr(f,".")=0Andf<>""Then
k=k+1
fn(k)=fn(i)&f&""
EndIf
f=Dir
LoopUntilf=""
i=i+1
Loop
'*******下面是提取各個文件夾的文件***
Forx=1ToUBound(fn)
Iffn(x)=""ThenExitFor
f3=Dir(fn(x)&"*.*")
DoWhilef3<>""
q=q+1
arr1(q,1)=fn(x)&f3
f3=Dir
Loop
Nextx
ActiveSheet.UsedRange=""
Range("a1").Resize(q)=arr1
MsgBoxFormat(Timer-t,"0.00000")
EndSub

效果如圖：