指定したフォルダ内のファイル名取得 No.1

指定したフォルダ内のファイル名を取得 (配列)

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

コメント