フォルダのファイル名書き出し

Sub フォルダ中のファイル名をシートに書く()

フォルダ = Cells(2, 2).Value

拡張子 = Cells(3, 2)

記入シート = "リンクシート" 'ファイル名の記入用シートを指定する
指定フォルダ中の指定拡張子のファイル名をシートに書く
End Sub
Private Sub 指定フォルダ中の指定拡張子のファイル名をシートに書く()
Sheets("ファイル名一覧").Activate 'ファイル名を記入用シートをアクティブにする
Range("C1").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents 'すべてクリア
Range("C1").Select
'パス = ドライブ & ":\" & フォルダ & "\" 'パスを組む

パス = フォルダ & "\"

ファイル名 = Dir(パス & 拡張子) '指定された拡張子のファイル名を取り出す
貼付行 = 0 '貼付行ポインタを初期化する
'
Do While ファイル名 <> "" '取り出したファイル名がヌルでなければ
貼付行 = 貼付行 + 1 '貼付行ポインタを上げる
Cells(貼付行, 2).Value = ファイル名 'セルにファイル名を記入する

ディスプレイ = Left(ファイル名, InStr(ファイル名, ".") - 1)
'ActiveSheet.Hyperlinks.Add Anchor:=Cells(貼付行, 1), Address:=ファイル名, TextToDisplay:=ディスプレイ

ActiveSheet.Hyperlinks.Add Anchor:=Cells(貼付行, 1), Address:=パス & ディスプレイ & ".jpg", TextToDisplay:=ディスプレイ
ファイル名 = Dir() '次のファイル名を取り出す
Loop '繰り返し処理
End Sub