vba獲得最後子文件夾路徑

❶ VB查找指定文件夾並獲取文件路徑的代碼

1.首先打開來Excel電子表格，然自後在開發工具中打開VBA編輯器，如下圖。

❷ 如何通過VBA，獲得本文件所在的文件夾路徑。

Subs()
Dimpth$
pth=ThisWorkbook.Path
MsgBox"本文件的路徑為："&pth
EndSub

❸ 如何用VBA復制整個文件夾包括子目錄

Sub Files(Path As String, afterPath)
'Path：原文件夾路徑；afterPath：目標文件夾路徑
Dim Spath As String
Set fs = CreateObject("Scripting.FileSystemObject")
Spath = Dir(Path, vbDirectory)
Do While Len(Spath)
If Spath <> "." And Spath <> ".." Then
fs.CopyFolder Path, afterPath
Spath = Dir()
End If
Loop
End Sub

————————————————
版權聲明：本文為CSDN博主「前端小菜鳥007」的原創文章，遵循CC 4.0 BY-SA版權協議，轉載請附上原文出處鏈接及本聲明。
原文鏈接：https://blog.csdn.net/weixin_41844140/article/details/103188537

❹ EXCEL VBA 獲取文件夾及子文件夾下所有文件並建立超鏈接

可以用代碼完成：
1、先編製表格：
2、在表格里編寫觸發宏代碼：
private
sub
worksheet_change(byval
target
as
range)
dim
photoname
as
string
if
target.row
=
3
and
target.column
>
3
and
target.column
<
6
then
on
error
resume
next
'忽略錯誤繼續執行vba代碼,避免出現錯誤消息
application.screenupdating
=
false
application.enableevents
=
false
for
each
shp
in
sheets("查詢表").shapes
if
shp.type
<>
8
and
shp.type
<>
12
then
shp.delete
end
if
next
photoname
=
cells(3,
4)
&
".jpg"
cells(3,
"l").select
activesheet.pictures.insert(activeworkbook.path
&
"\照片\"
&
photoname).select
'當前文件所在目錄下以單元內容為名稱的.jpg圖片
with
selection
ta
=
range(cells(3,
"l").mergearea.address).height
'單元高度
tb
=
range(cells(3,
"l").mergearea.address).width
'單元寬度
tc
=
.height
'圖片高度
td
=
.width
'圖片寬度
tm
=
application.worksheetfunction.min(ta
/
tc,
tb
/
td)
'單元與圖片之間長寬差異比例的最小值
.top
=
activecell.top
+
2
.left
=
activecell.left
+
1
.height
=
.height
*
tm
*
0.98
'按比例調整圖片寬度
.width
=
.width
*
tm
*
0.98
'按比例調整圖片高度
end
with
cells(3,
4).select
application.enableevents
=
true
application.screenupdating
=
true
end
sub
3、在當前目錄下建個名為」照片「的子目錄，裡面存有以姓名為名稱的.jpg格式的照片
4、在姓名後單元輸入姓名後，就能自動插入圖片了

❺ VBA中怎麼遍歷所選路徑中所有文件夾及其子文件夾(多個子文件)，並返回所有的最底層的文件夾路徑

答：執行"獲取所有文件夾"，按提示操作。文件夾清單會顯示在工作表的AB列中。

Sub獲取所有文件夾()
DimDirectoryAsString
WithApplication.FileDialog(msoFileDialogFolderPicker)
.InitialFileName=Application.DefaultFilePath&""
.Title="請選擇一個文件夾"
.Show
If.SelectedItems.Count=0Then
ExitSub
Else
Directory=.SelectedItems(1)
EndIf
EndWith
Cells.ClearContents
CallRecursiveDir(Directory)
EndSub
PublicSubRecursiveDir(ByValCurrDirAsString)
DimDirs()AsString
DimNumDirsAsLong
DimFilesizeAsDouble
DimTotalFolders,SingleFolder
Cells(1,1)="目錄名"
Cells(1,2)="日期/時間"
Range("A1:B1").Font.Bold=True

SetTotalFolders=CreateObject("Scripting.FileSystemObject").GetFolder(CurrDir).SubFolders
Cells(WorksheetFunction.CountA(Range("A:A"))+1,1)=CurrDir
Cells(WorksheetFunction.CountA(Range("B:B"))+1,2)=FileDateTime(CurrDir)
IfTotalFolders.Count<>0Then

ReDimPreserveDirs(0ToNumDirs)AsString
Dirs(NumDirs)=SingleFolder
NumDirs=NumDirs+1
Next
EndIf
Fori=0ToNumDirs-1
RecursiveDirDirs(i)
Nexti
EndSub