ActiveWorkbook.Pathの一つ下のフォルダ

ExcelマクロでActiveWorkbook.Pathの一つ下の階層のフォルダパスを取得する方法はありますか？

例えば、C:¥Users¥ユーザー名だった場合、
ActiveWorkbook.Pathで取得されますが、
C:¥Users¥ユーザー名¥Documentsの場合は、
どのように取得できるのか教えていただきたいです。

No.1 ベストアンサー 回答者： tatsu99 回答日時： 2019/12/09 16:30

以下のマクロは

ActiveWorkbook.Pathの一つ下の階層のフォルダパスを取得し、メッセージボックスに表示します。
標準モジュールに登録してください。
Sub Sample()
Dim FName As String
FName = Dir(ThisWorkbook.Path & "\" & "*", vbDirectory)
Do While FName <> ""
If (GetAttr(ThisWorkbook.Path & "\" & FName) And vbDirectory) > 0 And FName <> "." And FName <> ".." Then
MsgBox (FName)
End If
FName = Dir
Loop
End Sub

No.4 回答者： Qchan1962 回答日時： 2019/12/10 00:46

特殊フォルダを取得したいと言う事でしょうか？

その場合は、Windows Scripting Hostを使います。

Private Sub Sample_WshFol()
Dim MyPath As String
　MyPath = CreateObject("WScript.Shell").SpecialFolders("MyDocuments") & "\"
　'MyPath = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\"　’デスクトップ
　Debug.Print MyPath 'イミディエイトウィンドウに出力
End Sub

また、任意のサブフォルダを取得する場合は、FileSystemObjectを使います。
folder As Scripting.folderを使用している為、事前バインディングしてください。

参照設定（VBE-ツール）でMicrosoft Scripting Runtimeにチェックを入れてください。
Sample_SubFolを実行します。

Option Explicit
'Dim Pch_Arr() As Variant

Private Sub Sample_SubFol()
Dim fso As Scripting.FileSystemObject
　Set fso = New FileSystemObject
　　listSubFolders fso.GetFolder("C:\Users\"), 1
End Sub

Private Sub listSubFolders(ByVal folder As Scripting.folder, ByRef n As Long)
Dim fol As Scripting.folder
　　For Each fol In folder.SubFolders
　　　Debug.Print fol 'イミディエイトウィンドウに出力
' ReDim Preserve Pch_Arr(n)
' Pch_Arr(n) = fol & "\"
' n = n + 1
' listSubFolders fol, n '再帰処理
　　Next
　　Set fol = Nothing
End Sub
Sampleは、１つ下の（For Eachで）サブフォルダすべてを抽出しています。
コメント部は、（今回、気にしないでください。）配列にアドレスを入れる。また、さらにに下階層抽出

No.3 回答者： GOMΛFU 回答日時： 2019/12/09 18:06

C:¥Users¥ユーザー名¥Documents

にWorkbookを保存しとけばよいだけ。

No.2 回答者： GooUserラック 回答日時： 2019/12/09 16:30

一覧を取得すれば良いのでしょうか？

「ActiveWorkbook.Path」は「ActiveWorkbook」が保存されているパスなので上位フォルダは１つですが下位フォルダーは無かったり複数あったりします。