■PDF印刷の際にフォルダー名で保存する

Sub 出力_指定フォルダのファイル一覧()

Dim フォルダパス As String
Dim ファイル名 As String
Dim 行番号 As Long
Dim 対象フォルダ As FileDialog

' フォルダ選択ダイアログを表示
Set 対象フォルダ = Application.FileDialog(msoFileDialogFolderPicker)
対象フォルダ.Title = "フォルダを選択してください"

If 対象フォルダ.Show <> -1 Then
MsgBox "キャンセルされました", vbExclamation
Exit Sub
End If

フォルダパス = 対象フォルダ.SelectedItems(1) & "\"

' 初期化
行番号 = 1
ファイル名 = Dir(フォルダパス & "*.*")

' ファイルが見つかるまでループ
Do While ファイル名 <> ""
Cells(行番号, 1).Value = ファイル名
行番号 = 行番号 + 1
ファイル名 = Dir()
Loop

MsgBox "完了しました！", vbInformation

End Sub