指定したフォルダ内のファイルを取得する(セルに直接書き込み)
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
コメント