エクセルVBAで指定フォルダ内の選択ファイル名の取得

質問

お世話になります。
エクセルVBA昨日から始めた初心者です。

いま、
Private Sub CommandButton1_Click()
Dim Shell, myPath
Set Shell = CreateObject("Shell.Application")
Set myPath = Shell.BrowseForFolder(&O0, "フォルダを選んでください", &H1 + &H10, "\\hk001a24\va\data\ツール")
If Not myPath Is Nothing Then MsgBox myPath.Items.Item.Path
Set Shell = Nothing
Set myPath = Nothing
End Sub

というの作成したのですが、
これだとフォルダの選択しか出来ませんでした。
\\hk001a24\va\data\ツールの下にあるファイルを選択出来て、その選択したファイル名をVBA取得して保持できる
ようにしたいのですが・・・
急いでいるのでここで質問させて頂きました。
よろしくお願いします。

回答No.5

marbin · ベストアンサー

「ファイルを開く」で複数選択するサンプル
コードです。

Sub sentaku()
Dim Fs As Variant
Dim F As Variant
Dim i As Long
CreateObject("WScript.Shell").CurrentDirectory = "D:\marbin"
Fs = Application.GetOpenFilename("全てのファイル(*.*),*.*", _
Title:="ファイル選択", MultiSelect:=True)
If TypeName(Fs) = "Boolean" Then Exit Sub

For Each F In Fs
i = i + 1
Worksheets(1).Cells(i, 1).Value = F
Next
End Sub

回答No.8

noname#22222

既に正答が出てますので、この回答はフフーン位に読み流して下さい。

次は、Microsoft Scripting Runtime オブジェクトライブラリを利用した関数を用いるサンプルコードです。
VBエディターの[ツール]-[参照設定]で＜Microsoft Scripting Runtime＞にレ点を付ける必要があります。

Private Sub CommandButton1_Click()
　　Dim I　　　　　　　　 As Integer
　　Dim N　　　　　　　　 As Integer
　　Dim strFileNames(100) As String

　　N = GetFileList("C:\temp", strFileNames(), "*.csv") + 1
　　For I = 1 To N
　　　　Me.Cells(I, 1) = strFileNames(I)
　　Next I
End Sub

このコマンドボタンを実行すると、

t.csv
Test.csv
VBTest.csv

と 列Aに"C:\temp"に存在する拡張子 csv のファイルリストを表示します。

次は、GetFileList関数に関する説明文です。

GetFileList関数は、公的（Archive)なファイル一覧を取得しますが、これは、Dir関数が表示するファイルリストに一致します。
ところで、GetFileList関数では、 「参照による呼び出し」と呼ばれる ByRef(Call By Reference)キーワードを使っています。
これは、ByVal(Call By Value)「値による呼び出し」宣言された引数が、元の変数の局所的なコピーに過ぎないのに対し、元の引数にアクセスしてその値を書き換えることができることを意味しています。
注意を要するのは、GetFileList関数では strFileNames()を部分的に書き換えることです。
ですから、複数回コールされると、取得したファイル名が上書きされます。
もし、常に、完全なファイル一覧を要求するのであれば、 strFileNames()を初期化するコードが必要です。
ただし、通常は、呼び出し元の strFileNames() に対応する配列は局所的です。
ですから、ほとんど自動的に初期化されます。
また、新たに取得したファイル総数だけを反映させることに徹するとすれば、わざわざ初期化する必要はありません。

＜GetFileList関数＞

Public Function GetFileList(ByVal strDir As String, _
　　　　　　　　　　　　　　ByRef strFileNames() As String, _
　　　　　　　　　　　　　　Optional strName As String = "*") As Integer
'On Error GoTo Err_GetFileList
　　 Dim I　　　 As Integer
　　 Dim J　　　 As Integer
　　 Dim N　　　 As Integer
　　 Dim fso　　 As FileSystemObject
　　 Dim fol　　 As Folder
　　 Dim fil　　 As File
　　 Dim fils　　As Files

　　 Set fso = New FileSystemObject
　　 Set fol = fso.GetFolder(strDir)
　　 Set fils = fol.Files

　　 I = I - 1
　　 N = UBound(strFileNames())
　　 For Each fil In fils
　　　　 If fil.Name Like strName And fil.Attributes = Archive Then
　　　　　　 I = I + 1
　　　　　　 strFileNames(I) = fil.Name
　　　　 End If
　　　　 If I = N Then
　　　　　　 MsgBox N & " 件でファイル名の取得を中止します。(GetFileList)", vbExclamation, " 関数メッセージ"
　　　　 End If
　　 Next
　　 For J = I + 1 To N
　　　　 strFileNames(J) = Empty
　　 Next J
Exit_GetFileList:
　　 GetFileList = I
　　 Exit Function
Err_GetFileList:
　　 I = -1
　　 MsgBox Err.Description & "(GetFileList)", vbExclamation, " 関数エラーメッセージ"
　　 Resume Exit_GetFileList
End Function

回答No.7

marbin

No.1とNo.2で提示したコードは取得できるのはフォルダ
のみです。
ファイルを選択したらエラーになります。
rarikoさんの質問の意図を取り違えてしまい、選択
フォルダの中の全てのファイルを取得する、と取ってま
した。

回答No.6

dacchin

こんな方法もあるかと思います。

sub xxx()
Dim strFlNm() As String
With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = True
.Show

If .SelectedItems.Count = 0 Then
MsgBox "ファイルが選択されていません"
Exit Sub
End If
ReDim strFlNm(.SelectedItems.Count)
For i = 1 To .SelectedItems.Count
strFlNm(i) = .SelectedItems(i)
Next
End With
End Sub

変数の宣言は省いております。

回答No.4

marbin

>\\hk001a24\va\data\ツールの下にあるファイルを選択出来て、その選択したファイル名をVBA取得して保持できる

見落としてました。
選択したいファイルは単数ですか？
複数の場合もありますか？

補足

すみません、
単数です。
よろしくお願いします。

ちなみに下記ご回答のロジックを実行したらエラーがでました

回答No.3

merlionXX

わたしもVBA初心者ですが・・・

ファイル名を取得するならこんなのでもできますよ。

Sub test()
myfn = Application.GetOpenFilename
MsgBox myfn
End Sub

回答No.2

marbin

間違いがありました。訂正です。

>Dim Fol as sring

Dim Fol as String

>F =Dir(Fol & "\*.*)

F =Dir(Fol & "\*.*")

失礼しました。

回答No.1

marbin

こんな感じかな？

Private Sub CommandButton1_Click()
Dim Shell, myPath
Dim Fol as sring
Dim F as string
Set Shell = CreateObject("Shell.Application")
Set myPath = Shell.BrowseForFolder(&O0, "フォルダを選んでください", &H1 + &H10, "\\hk001a24\va\data\ツール")
If Not myPath Is Nothing Then MsgBox myPath.Items.Item.Path
Fol = MyPath.Self.Path
F =Dir(Fol & "\*.*)
Do While F <> ""
MsgBox F
F =Dir()
Loop
Set Shell = Nothing
Set myPath = Nothing
End Sub