こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

エクセル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取得して保持できる
ようにしたいのですが・・・
急いでいるのでここで質問させて頂きました。
よろしくお願いします。

投稿日時 - 2006-09-06 13:56:12

QNo.2387735

すぐに回答ほしいです

質問者が選んだベストアンサー

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

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

投稿日時 - 2006-09-06 14:30:39

ANo.5

このQ&Aは役に立ちましたか?

0人が「このQ&Aが役に立った」と投票しています

回答(8)

ANo.8

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

次は、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

投稿日時 - 2006-09-06 14:51:38

ANo.7

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

投稿日時 - 2006-09-06 14:37:37

ANo.6

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

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

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

投稿日時 - 2006-09-06 14:37:30

ANo.4

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

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

投稿日時 - 2006-09-06 14:22:24

補足

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

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

投稿日時 - 2006-09-06 14:29:01

ANo.3

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

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

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

投稿日時 - 2006-09-06 14:19:35

ANo.2

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


>Dim Fol as sring

Dim Fol as String

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

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

失礼しました。

投稿日時 - 2006-09-06 14:16:56

ANo.1

こんな感じかな?

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

投稿日時 - 2006-09-06 14:12:45

あなたにオススメの質問