指定したフォルダ内のファイル名を取得 (配列)
Option Explicit
Option Base 1
Sub GetFilesNameList()
Dim fso As Object
Dim fileName As Object '取得するファイル
Dim folderName As String 'ファイル名を取得するフォルダ名
Dim fileNamesArray() As String '取得したファイル名を格納する配列
folderName = ""
Set fso = CreateObject("Scripting.FileSystemObject")
'フォルダを選択するプロシージャの呼び出し
folderName = GetFolderName
'ファイルオブジェクト取得
Set fileName = fso.getFolder(folderName).Files
'時間計測用(開始)-------------
Dim myspeed As Double
Dim starttime As Double
starttime = Timer
'---------------------------
Dim f As Object
Dim c As Long 'カウンタ変数
c = 0
'ファイルオブジェクト取り出して配列格納
For Each f In fileName
c = c + 1
ReDim Preserve fileNamesArray(c)
fileNamesArray(c) = f.Name
Next f
'ActiveSheetのデータをクリア後、書き込み
Dim i As Integer
With ActiveSheet
.Cells.Clear
.Cells(1, 1).Value = "ファイル名"
.Cells(1, 1).Font.Bold = True
'配列数が0の場合、フォルダ内にファイルなしの為、終了処理
If c = 0 Then
Set fso = Nothing
Set fileName = Nothing
MsgBox "フォルダの中にファイルはありません"
Exit Sub
End If
'配列をセルに書き込み
For i = 1 To UBound(fileNamesArray)
.Cells(i + 1, 1).Value = fileNamesArray(i)
Next i
'A列を自動調整
.Columns("A:A").EntireColumn.AutoFit
End With
Set fso = Nothing
Set fileName = Nothing
'時間計測用(終了)-------------
myspeed = Timer - starttime
Debug.Print "1_処理時間は" & myspeed & "秒です"
'---------------------------
MsgBox "完了"
End Sub
'フォルダ選択ダイアログから、選択されたフォルダパスを取得
Function GetFolderName()
Dim folderName As String
folderName = ""
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "フォルダ選択"
If .Show = True Then
folderName = .SelectedItems(1) 'フルパス
Else
MsgBox "フォルダを選択してください"
End
End If
End With
GetFolderName = folderName
End Function
コメント