Excel VBAで新たな保存先のパスの取得方法は？

質問

エクセルＶＢＡで新たに一度に作成する複数のブックを保存するフォルダーをあらかじめ指定したいのですが、下記のような方法しか思い浮かびません。
もっとスマートなやり方はないでしょうか？（直接入力以外の方法で）

Sub Path_Get()

Dim myPath As String, damy As Variant

MsgBox "作成するファイルの保存先を選択します。" _
& vbCr & "なお、表示されたファイル名は気にしないで" _
& vbCr & "下さい。（笑）"
damy = Application.GetSaveAsFilename(fileFilter:="Excel (*.xls),*.xls")
MsgBox damy

If damy = False Then Exit Sub

For i = Len(damy) To 0 Step -1

If Mid(damy, i, 1) = "\" Then
myPath = Mid(damy, 1, i)
Exit For
End If
Next i
MsgBox "パスは " & myPath & "です。"

End Sub

回答No.1

list · ベストアンサー

私は初心者ですので、誰か、回答してくれないかなって見ていたのですが、なかなか無く、他の人に聞いた他のサイトで検索したら、shishishishiの希望されている内容がありました。
こんな感じで良いのですよね？
最近、同サイトのメーリングリストを登録したのですが、初心者の私には難しい事を言っていて分からないものも一杯ありますけどね・・・

Sub フォルダ選択()
　　Dim ff As Object
　　Set ff = CreateObject("Shell.Application"). _
　　　BrowseForFolder(0, "フォルダを選択してください", 0)
　　If Not ff Is Nothing Then
　　　MsgBox ff.Self.Path
　　End If
End Sub

参考URL：

http://www2.moug.net/app/bbs/message.php?cat=exvba&id=20031027-000034

補足

ありがとうございました。
残念ながら「実行時エラー438.オブジェクトはこのプロパティまたはメソッドをサポートしていません」となってしまいました。（エクセルのバージョンは2000で試しました。）

参考ＵＲＬも拝見しましたが、そこにあったようにデスクトップを指定するとエラーになるという

MsgBox ff.Items.Item.Path

とやると、デスクトップ以外ではＯＫでした。
さて、どうしましょうか。
もうすこし待ってみます。ありがとうございました。

回答No.5

list

度々すみません
#1です。
#5の補足をさせて下さい。

Excel2002で実行したところ、問題なく実行出来ました。

でも、Excel2000は職場に行かないと確認出来ないので確認出来ませんけど・・・

お礼

大変遅くなり申し訳ございません。
ありがとうございました。

回答No.4

list

こんばんは　#1です。

職場のパソコンはExcel2000ですので、#1で記載したマクロを同パソコンで実施したところ、ディスクトップも問題なく表示されました。

また、マイネットワークやマイコンピューターもエラーが発生することなく表示されました。
勿論、ディスクトップと違って特定の実際のフォルダがあるわけで無いため、
マイコンピューター：「::{20D04FE0-3AEA-1069-A2D8-08002B30309D}」
マイネットワーク：「::{208D2C60-3AEA-1069-A2D7-08002B30309D}」
などと表示されました。

以上、Excel2000での結果報告です。
すみません、self.pathを調べたのですが分かりませんでした。
初心者の私には結果報告以上無理でした・・・。

回答No.3

list

度々すみません
#1です。

Excel2002で以下の用にすれば、ディスクトップ以外のフォルダに関しては、出来ました。
初心者ですので、強引な手法で申し訳ありません。

Sub フォルダ選択()
　Dim ff As Object
　Set ff = CreateObject("Shell.Application"). _
　　BrowseForFolder(0, "フォルダを選択してください", 0)
　If Not ff Is Nothing Then
　　On Error Resume Next
　　MsgBox ff.Items.Item.Path
　　If Err = 91 Then End
　End If
End Sub

補足

何度もすみません。上記の方法だとデスクトップを選択した際のエラーを回避して何もせずに終了させるのですね。

それなら最初からＣドライブ以下しか表示させなければいいわけで、とりあえずは

Sub Excl_DP選択()
Dim ff As Object
Set ff = CreateObject("Shell.Application"). _
BrowseForFolder(0, "フォルダを選んでネ", 0, "c:\")
If Not ff Is Nothing Then
MsgBox ff.Items.Item.Path
End If
End Sub

でやってもいいのですが、他に方法はないですかねえ。

回答No.2

list

#1です。

私は、Excel2002で試して上手く出来ました。
> 「実行時エラー438.オブジェクトはこのプロパティまたはメソッド
これは、どこで発生したのですかね？
> MsgBox ff.Items.Item.Path
では上手く出来たと記載されていますが、ディスクトップ以外は問題無く表示されたのであれば、エラー回避処理をして、強引に処理させれば、最低限、ディスクトップ以外であれば出来るのかな？

すみません
初心者ですので、掲載したマクロの意味も分からず、また、自宅ではExcel2002しか無いために実際に出来るか分からず回答していますので間違いがあれば申し訳ありません。

補足

> 私は、Excel2002で試して上手く出来ました。

バージョンが違うとダメなケースってよくありますよね。

> 「実行時エラー438.オブジェクトはこのプロパティまたはメソッド 、これは、どこで発生したのですかね？

MsgBox ff.Self.Path　です。すべてのフォルダでアラーになります。
　MsgBox ff.Items.Item.Path ならデスｌクトップ以外はＯＫでした。