EXCEL VBA で指定したフォルダのファイル名一覧

EXCELで指定したフォルダのファイル名一覧をセルに入力するVBAを作成したのでメモしておきます。
以下のサイトを参考にしましたというか、コピペです。

http://www.asahi-net.or.jp/~ef2o-inue/vba_o/sub05_110_080.html
http://officetanaka.net/excel/vba/tips/tips39.htm

動きとしては、フォルダを指定するダイヤログボックスが起動し、指定したら、そのフォルダのファイル名一覧をA列のセルに入力します。

以下がソースです。

Sub Display_Directory()
Const cnsDIR = “*.*”
Dim xlAPP As Application
Dim strPATHNAME As String
Dim strFILENAME As String
Dim GYO As Long
Cells.Select
Selection.ClearContents
Range(“A1″).Select
Set xlAPP = Application
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show = True Then
MsgBox .SelectedItems(1) & ” のファイル一覧を取得します。”
strPATHNAME = .SelectedItems(1)
End If
End With
If StrConv(strPATHNAME, vbUpperCase) = “FALSE” Then Exit Sub
‘ フォルダの存在確認
If Dir(strPATHNAME, vbDirectory) = “” Then
MsgBox “指定のフォルダは存在しません。”
Exit Sub
End If

‘ 先頭のファイル名の取得
strFILENAME = Dir(strPATHNAME & cnsDIR, vbNormal)
‘ ファイルが見つからなくなるまで繰り返す
Do While strFILENAME <> “”
‘ 行を加算
GYO = GYO + 1ツ黴€ツ黴€ツ黴€ツ黴€ツ黴€ツ黴€ ‘ 先頭は1行目
Cells(GYO, 1).Value = strFILENAME
‘ 次のファイル名を取得
strFILENAME = Dir()
Loop
MsgBox “完了”
End Sub



コメントを残す