質問

ExcelのVBAでフォルダ名の取得

質問者：Mr-J
投稿日時：2003/04/16 01:13

お世話になります。
タイトルのままなんですが、
ＶＢＡでフォルダのフルパスを取得したいのですが出来るでしょうか？
ファイルのフルパスは FN = Application.GetOpenFilename で取得出来たのですが
同じ様に　ダイアログから選択する様に出来るでしょうか？

通報する

この質問への回答は締め切られました。

質問の本文を隠す

回答 (4件)

No.4ベストアンサー10pt

回答者：ja7awu
回答日時：2003/04/22 09:50

>> ＶＢＡでフォルダのフルパスを取得したいのですが出来るでしょうか？

> フォルダを選ぶと、そのフォルダの中のファイルを
> 全部表示するようにしたいのです。

うぅ～ん　どっちなんでしょうかね。
なんか趣旨が一貫していないような気がしますが・・・

ホルダだけ指定するのであれば、組込みのダイアログを使用するのは、
無理があると思います。

それであればフォルダ名を選択するフォームを作ったら如何でしょうか。

選択するホルダは、ある１個のホルダの中の複数のホルダということで
いいのですか？

下記の例は、フォームにリストボックスとコマンドボタンを配置し、
そのリストボックスに表示されたフォルダの中から選択するように
したものです。

例では、ユーザーフォームの名前を UserForm1、リストボックスの名前を
ListBox1 とします。
"c:\test\"の中のホルダをリストボックスに表示し、選択したホルダの
中の標準ファイルだけをMsgBoxに表示します。

やりたいことがいまいち解りませんので、外れているかも知れませんが、
推測したところでは、こんな感じです。

Public MyPath As String
Sub test2()
Dim MyName As String
MyPath = "c:\test\"
MyName = Dir(MyPath, vbDirectory)
UserForm1.Show (vbModeless)
UserForm1.ListBox1.Clear
Do While MyName <> ""
　　If MyName <> "." And MyName <> ".." Then
　　　　If (GetAttr(MyPath & MyName) And vbDirectory) = _
　　　　　　vbDirectory Then
　　　　　　With UserForm1.ListBox1
　　　　　　　　.AddItem MyName
　　　　　　　　.ListIndex = 0
　　　　　　End With
　　　　End If
　　End If
　　MyName = Dir
Loop
End Sub

Private Sub CommandButton1_Click()
Dim FName As String
Dim Rw As Integer
Dim FNdsp As String
MyPath = MyPath & Me.ListBox1.Value & "\"
FName = Dir(MyPath, vbNormal)
Do While FName <> ""
　　If FName <> "." And FName <> ".." Then
　　　　If (GetAttr(MyPath & FName) And vbNormal) = _
　　　　　　vbNormal Then
　　　　　　Rw = Rw + 1
'　　　　　　Cells(Rw, 1).Value = FName
　　　　　　FNdsp = FNdsp & MyPath & FName & vbCrLf
　　　　End If
　　End If
　　FName = Dir
Loop
UserForm1.Hide
MsgBox FNdsp
End Sub

この回答へのお礼

回答ありがとうございました。
無事解決することができました。
また、疑問がありましたら
よろしくお願いします。

この回答への補足

すみません、質問がごちゃごちゃしてしまいました。
今作ってるのが、フォルダ名をセルに入れてＶＢＡを実行すると
セルにファイルのリストを表示するものなので
そのフォルダ名を簡単に取得出来ないものかと調べていました。

通報する

No.3ベストアンサー20pt

回答者：sakenomo
回答日時：2003/04/21 18:29

こんな使い方が正しいかどうか分かりませんし、ご希望のものとは少し違うかもしれませんが、参考までに…。

Sub Test2()
　　Dim FileName As Variant
　　FileName = Application.GetSaveAsFilename _
　　　　(InitialFileName _
　　　　　　　:="フォルダを選択してください", _
　　　　FileFilter:="(*.---),*", _
　　　　Title:="フォルダの選択")
　　If FileName = False Then Exit Sub
　　MsgBox Mid(FileName, 1, _
　　　　　InStrRev(FileName, "\") - 1)
End Sub

この回答へのお礼

回答ありがとうございました。
無事解決することができました。
また、疑問がありましたら
よろしくお願いします。　

この回答への補足

なかなか　いい感じに出来ました。
ありがとうございます。

通報する

No.2

回答者：sakenomo
回答日時：2003/04/17 17:38

こんなのはどうでしょう、他にもっと良い方法があるのかもしれませんが。

Sub Test()
　　Dim FileName As Variant
　　FileName = Application.GetOpenFilename _
　　　　　　　("JPEGファイル (*.jpg),*.jpg")
　　If FileName = False Then Exit Sub
　　MsgBox Mid(FileName, 1, _
　　　　　　　　InStrRev(FileName, "\") - 1)
End Sub

この回答への補足

回答ありがとうございます。
このＶＢＡと同じように、ファイルを選択してフォルダ名を取得するようにしてるのですが
これを、直にフォルダを選ぶようにしたいのです。
よろしくお願いします。

質問者のみ
この回答にお礼をつける

通報する

No.1

回答者：ja7awu
回答日時：2003/04/16 10:05

一例ですが、下記のコードは、ファイル選択ダイアログからファイル（複数可）を
選択し、フルパスでファイル名をアクティブシートのA1から下へ書き込みます。

Sub test1()
　　Dim FName As Variant
　　Dim I As Integer
　　FName = Application.GetOpenFilename _
　　　　("Excelファイル (*.xls), *.xls", , , , True)
　　　　For I = 1 To UBound(FName)
　　　　　　ActiveSheet.Cells(I, 1).Value = FName(I)
　　　　Next I
End Sub

こんなもので、どうにか参考になりませんか。