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

指定したフォルダ内のファイルを取得する(セルに直接書き込み)

Option Explicit
Option Base 1

Sub GetFilesNameList2()
  Dim fso As Object
  Dim folderName As String      'ファイル名を取得するフォルダ名
  Dim fileName As Object        '取得するファイル
  
  folderName = ""
  Set fso = CreateObject("Scripting.FileSystemObject")
  
  
  'フォルダを選択するプロシージャの呼び出し
  folderName = GetFolderName
  Set fileName = fso.getFolder(folderName).Files
  
  Dim f As Object
  Dim c As Long 'カウンタ変数
  c = 1

 '時間計測用(開始)-------------
    Dim myspeed As Double
    Dim starttime As Double
    starttime = Timer
'---------------------------
  
 'ActiveSheetのデータをクリア後、書き込み
  With ActiveSheet
    .Cells.Clear
    .Cells(1, 1).Value = "ファイル名"
    .Cells(1, 1).Font.Bold = True
        
    For Each f In fileName
       c = c + 1
      .Range("A" & c).Value = f.Name
    Next f
    
    .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

コメント