フォルダ名だけを取得するVBA

質問

VBAを使ったエクセルテンプレート適用ツールを作成しているのですが
そのVBAのことで教えてください。

現在自作のフォーム上にあるテキストボックスにフルパスが入っているとします（添付図参照）。
＊この前提は必須と考えてください。

次に作成ボタンをクリックすると
Step1 新しいブックが開かれ行幅や書式などが自動で調整されます。
Step2 ブックの保存ダイアログが自動で開きます。
　　　　ただし、保存ダイアログが開いた時点で自作フォーム中の
　　　　テキストボックスで指定したフルパスに移動しており、
　　　　且つ移動先のフォルダ名（<-注意！！フルパス名ではありません！！）と
　　　　同じ文字列をファイル名入力欄に自動で入力されるようにします。
　　　ex) D:\MyProject\Project01\TaskA\にブックを作成し保存する場合、
　　　　　保存ダイアログのファイル名欄にTaskAとだけ書く。
マクロ自体はここでストップし、これ以降はユーザーがそのファイルメモで
保存してよいかどうかを判断し、問題なければ手動でダイアログ上の「保存」ボタンを押します。

問題はStep2で、保存先のフォルダ名と同じ文字列を保存ダイアログのファイル名に記入するには
どのようなコードを書いたらよいでしょうか。
私自身としては下記の二案を考えているのですがそれぞれについて疑問があるので教えてください。

案1 作成ボタンを押した時点でテキストボックスに書かれているフルパスの文字列から
　　末尾にあるフォルダ名だけを取得して変数に代入し、これを保存ダイアログの
　　ファイル名欄に反映させる。
　　疑問：テキストボックスのValue値に書かれているフルパスを示す文字列から
　　　　　末尾のフォルダ名だけを取得するためのコードは何と書けばよいのでしょうか？

案2 ブックの保存ダイアログが開いて保存先のパスに移動してから今保存ダイアログで
　　　開いているフォルダ名を取得する。
　　　疑問：今アクティブになっているブックが保存されているフォルダ名だけを取得する
　　　方法なら確かあったような気がしています。
　　　しかし今保存ダイアログで表示されているフォルダ名を取得するコードは何と
　　　書けばよいのでしょうか？
　　　そもそもそういったコードや操作自体VBAにあるのでしょうか？

回答No.2

WindFaller

こんばんは。

>そもそもそういったコードや操作自体VBAにあるのでしょうか？
あるというよりも、ゴリ押しという感じですね。

あまり自然なコードとは言えませんね。なぜかというと、
>保存ダイアログのファイル名欄にTaskAとだけ書く。
ここが特殊です。ミスタイプした時は、エラーを出すか、新たにフォルダーを作るかどちらかになってしまいます。

だから、私などは、
Application.Dialogs(xlDialogSaveAs).Show
Application.GetSaveAsFilename

と、使うのが通例で、あまり凝った方法はしません。

私は、フォルダを選ぶために、こんなものを使っていました。
昔作ったものが、Windows7 だと違うコードになりましたので、ちょっと変形になってしまいました。
フォルダーを選ばせるダイアログを出すものです。ただし、フォルダーの数が多すぎると、使いづらいです。

'//
Dim objShell As Object
Dim wsShell As Object
Dim wsSysEnv As Object
Dim User As String
Dim objFolder As Object

Set objShell = CreateObject("Shell.Application")
Set wsShell = CreateObject("WScript.Shell")
Set wsSysEnv = wsShell.Environment("PROCESS")
User = wsSysEnv("USERNAME")

Set objFolder = objShell.BrowseForFolder(0, "フォルダを選択してください。", _
　　　　　　　　 0, "C:\Users\" & User & "\My Documents\")
MsgBox objFolder.Self.Path

'//

最後の、「"C:\Users\" & User & "\My Documents\"」が、ベース（基点）となるわけです。

---
>今アクティブになっているブックが保存されているフォルダ名
myPath = CurDir()

「今保存ダイアログで表示されているフォルダ名を取得するコードは何と書けばよいのでしょうか？」というなら、

Filename = "C:\Users\TestUser\Documents\Text\test2014-04-29.txt"
myPath = Left(Filename, InStrRev(Filename, "\"))
'myPath は、"C:\Users\TestUser\Documents\Text\" と取れる

など、いくつか方法はあります。

回答No.1

eden3616

ファイル名を含むパスからフォルダパスを取得するには

Dir関数でファイル名を取得してから元のパスからファイル名を消せば手軽にできます。
http://officetanaka.net/excel/vba/tips/tips78.htm

以下サンプルです

'Dim buf() As Variant
file_path = "U:\テストフォルダ\テストファイル.txt"
'置換でフォルダパスを取得
Debug.Print Replace(file_path, Dir(file_path), "")
'1文字ずつチェック
For i = Len(file_path) To 1 Step -1
If Mid(file_path, i, 1) = "\" Then Debug.Print Left(file_path, i): Exit For
Next i

Dirは存在するファイルのファイル名を取得するため、実際にファイルが無い場合はほかの方法を使ってください

ほかにもsplitで[\]で区切った後、最後の要素を外して結合し直すとか。