生成AI活用研究
生成AIと100本ノック 26本目：ファイル一覧作成

Geminiを中心に生成AIの活用と研究の記録
公開日：2025-06-06　最終更新日：2025-06-06

生成AIと100本ノック 26本目：ファイル一覧作成


AIのGeminiがVBA100本ノックに挑戦！
ということでシリーズを開始しましたが、ある程度回もすすんだので、検証方法を変更することにしました。


独自に作成した、VBA開発の汎用プロンプト（命名：AI神髄VBA）が、他のお題で確認している範囲内では、かなり良い成果を出せています。
そこで、このプロンプトのさらなる改善と最終検証を目的として、100本ノックを進めていくことにします。

以下の代表的な生成AI3つで確認を進めます。
🤖 Gemini（2.5 Pro）（課金済の有料版）
🤖 ChatGPT（GPT-3.5）（無課金の無料版）
🤖 Claude（Sonnet4）（無課金の無料版）



VBA100本ノックの出題と解答

VBA100本ノック 26本目：ファイル一覧作成
・出題 ・頂いた回答 ・解説 ・補足 ・サイト内関連ページ


Geminiへの出題とGeminiの回答

Geminiの回答 Geminiへの出題
【VBAを作成】
フォルダ選択のダイアログでフォルダを指定し、フォルダ内にあるファイルの一覧を「ファイル一覧」シートのA列に出力してください。
・ファイル名,更新日時,サイズ※画像参照
・Excelファイル(xls,xlsx,xlsm)にはハイパーリンクを設定
※サブフォルダは不要です。

-------------------- ここから共通プロンプト --------------------

ここから下に、「AI神髄VBA」の汎用プロンプトを貼り付けます。
はい、承知いたしました。
フォルダを選択し、そのフォルダ内にあるファイルの一覧（ファイル名、更新日時、サイズ）を指定のシートに出力し、Excelファイルにはハイパーリンクを設定するVBAコードを、ご提示の要件に沿って作成します。

完成したVBAコード
以下に、業務品質レベルの要件を満たすVBAコードを記載します。
モジュールにコピー＆ペーストしてご利用ください。

VBA
'=========================================
' Module: modFileListGenerator
' Description: 指定されたフォルダ内のファイル一覧を作成するモジュール
'=========================================

' --- 定数定義 ---
' シート名を定数で管理し、変更を容易にします。
Private Const TARGET_SHEET_NAME As String = "ファイル一覧"

' 出力するヘッダー名を定数で定義します。
Private Const HEADER_FILE_NAME As String = "ファイル名"
Private Const HEADER_MODIFIED_DATE As String = "更新日時"
Private Const HEADER_FILE_SIZE As String = "サイズ(byte)"


'-----------------------------------------
' 機能: メインプロシージャー。全体の処理フローを制御します。
' 引数: なし
' 戻り値: なし
' 備考: 各サブプロシージャーを呼び出し、一連の処理を実行します。
'　　　 アプリケーション設定の最適化と、包括的なエラーハンドリングも担当します。
'-----------------------------------------
Public Sub Main_ListFilesInFolder()
　　' --- 高速化設定 ---
　　Application.ScreenUpdating = False
　　Application.Calculation = xlCalculationManual
　　Application.EnableEvents = False

　　On Error GoTo ErrorHandler

　　' --- 変数宣言 ---
　　Dim wsTarget As Worksheet
　　Dim strFolderPath As String
　　Dim arrFileList As Variant

　　' 1. 初期化：出力先シートを取得・準備
　　Set wsTarget = Get_TargetSheet(TARGET_SHEET_NAME, True)
　　If wsTarget Is Nothing Then GoTo CleanUp 'シート準備に失敗した場合は終了

　　' 2. フォルダ選択：ユーザーにフォルダを選択させる
　　strFolderPath = Get_SelectedFolderPath()
　　If strFolderPath = vbNullString Then GoTo CleanUp 'キャンセルされた場合は終了

　　' 3. データ取得：ファイル一覧情報を配列として取得
　　arrFileList = Logic_CreateFileList(strFolderPath)

　　' 4. データ出力：取得したファイル一覧をシートに書き込む
　　Call Write_FileListToSheet(strFolderPath, wsTarget, arrFileList)

CleanUp:
　　' --- アプリケーション設定を元に戻す ---
　　Application.ScreenUpdating = True
　　Application.Calculation = xlCalculationAutomatic
　　Application.EnableEvents = True

　　Set wsTarget = Nothing
　　Exit Sub

ErrorHandler:
　　MsgBox "予期せぬエラーが発生しました。" & vbCrLf & vbCrLf & _
　　　　　 "エラー番号: " & Err.Number & vbCrLf & _
　　　　　 "エラー内容: " & Err.Description, vbCritical, "エラー"
　　Resume CleanUp
End Sub


'-----------------------------------------
' 機能: 処理対象のワークシートを取得し、必要に応じてクリアします。
' 引数: strSheetName (String) - 対象のシート名
'　　　 bClearSheet (Boolean) - Trueの場合、シートの内容をクリアする
' 戻り値: Worksheet - 取得したワークシートオブジェクト。失敗した場合はNothing。
' 備考: シートが見つからない場合はメッセージを表示します。
'-----------------------------------------
Private Function Get_TargetSheet(ByVal strSheetName As String, ByVal bClearSheet As Boolean) As Worksheet
　　Dim ws As Worksheet
　　On Error Resume Next
　　Set ws = ThisWorkbook.Worksheets(strSheetName)
　　On Error GoTo 0

　　If ws Is Nothing Then
　　　　MsgBox "シート「" & strSheetName & "」が見つかりません。" & vbCrLf & _
　　　　　　　 "処理を中断します。", vbExclamation, "シート未検出"
　　　　Set Get_TargetSheet = Nothing
　　　　Exit Function
　　End If

　　If bClearSheet Then
　　　　ws.Cells.Clear
　　End If

　　Set Get_TargetSheet = ws
End Function


'-----------------------------------------
' 機能: フォルダ選択ダイアログを表示し、ユーザーが選択したフォルダのパスを返します。
' 引数: なし
' 戻り値: String - 選択されたフォルダのフルパス。キャンセルされた場合は空文字列。
' 備考: レイトバインディングを使用しています。
'-----------------------------------------
Private Function Get_SelectedFolderPath() As String
　　Dim fDialog As Object 'Office.FileDialog
　　Set fDialog = Application.FileDialog(4) 'msoFileDialogFolderPicker = 4

　　fDialog.Title = "ファイル一覧を取得するフォルダを選択してください"
　　fDialog.AllowMultiSelect = False

　　If fDialog.Show = -1 Then 'OKボタンが押された場合
　　　　Get_SelectedFolderPath = fDialog.SelectedItems(1)
　　Else 'キャンセルされた場合
　　　　Get_SelectedFolderPath = vbNullString
　　End If

　　Set fDialog = Nothing
End Function


'-----------------------------------------
' 機能: 指定されたフォルダ内のファイル情報を取得し、2次元配列として返します。
' 引数: strFolderPath (String) - ファイル情報を取得するフォルダのパス
' 戻り値: Variant - ファイル情報（名前, 更新日時, サイズ）を格納した2次元配列。
'　　　　　　　　 ファイルが存在しない場合はEmpty値。
' 備考: サブフォルダは処理対象外です。レイトバインディングを使用しています。
'-----------------------------------------
Private Function Logic_CreateFileList(ByVal strFolderPath As String) As Variant
　　Dim fso As Object　　　 'Scripting.FileSystemObject
　　Dim fld As Object　　　 'Scripting.Folder
　　Dim objFile As Object　 'Scripting.File
　　Dim arrOutput() As Variant
　　Dim i As Long

　　Set fso = CreateObject("Scripting.FileSystemObject")
　　Set fld = fso.GetFolder(strFolderPath)

　　If fld.Files.Count = 0 Then
　　　　Logic_CreateFileList = Empty
　　　　GoTo CleanUp
　　End If

　　'--- ファイル数分の配列を準備 ---
　　ReDim arrOutput(1 To fld.Files.Count, 1 To 3)
　　i = 1

　　'--- ファイル情報を配列に格納 ---
　　For Each objFile In fld.Files
　　　　arrOutput(i, 1) = objFile.Name
　　　　arrOutput(i, 2) = objFile.DateLastModified
　　　　arrOutput(i, 3) = objFile.Size
　　　　i = i + 1
　　Next objFile

　　Logic_CreateFileList = arrOutput

CleanUp:
　　Set fso = Nothing
　　Set fld = Nothing
　　Set objFile = Nothing
End Function


'-----------------------------------------
' 機能: 配列データをシートに書き込み、Excelファイルにハイパーリンクを設定します。
' 引数: strFolderPath (String) - ファイルが格納されているフォルダパス
'　　　 wsTarget (Worksheet) - 書き込み先のワークシートオブジェクト
'　　　 arrData (Variant) - 書き込むファイル情報の2次元配列
' 戻り値: なし
' 備考: ファイル情報配列が空の場合は、メッセージを表示して処理を終了します。
'-----------------------------------------
Private Sub Write_FileListToSheet(ByVal strFolderPath As String, ByRef wsTarget As Worksheet, ByRef arrData As Variant)
　　'--- ファイルデータが存在しない場合は処理を終了 ---
　　If Not IsArray(arrData) Then
　　　　MsgBox "指定されたフォルダにファイルが見つかりませんでした。", vbInformation, "ファイルなし"
　　　　Exit Sub
　　End If

　　'--- ヘッダーの書き込み ---
　　Dim rngHeader As Range
　　Set rngHeader = wsTarget.Range("A1:C1")
　　rngHeader.Value = Array(HEADER_FILE_NAME, HEADER_MODIFIED_DATE, HEADER_FILE_SIZE)
　　rngHeader.Font.Bold = True

　　'--- ファイル一覧データを一括書き込み ---
　　Dim rngOutput As Range
　　Set rngOutput = wsTarget.Range("A2").Resize(UBound(arrData, 1), UBound(arrData, 2))
　　rngOutput.Value = arrData

　　'--- ハイパーリンクの設定 ---
　　Dim i As Long
　　Dim rngCell As Range
　　For i = 1 To UBound(arrData, 1)
　　　　'--- Excel関連ファイルの場合のみハイパーリンクを設定 ---
　　　　If LCase(arrData(i, 1)) Like "*.xls" Or _
　　　　　 LCase(arrData(i, 1)) Like "*.xlsx" Or _
　　　　　 LCase(arrData(i, 1)) Like "*.xlsm" Then

　　　　　　Set rngCell = wsTarget.Cells(i + 1, 1) 'A列のセル
　　　　　　wsTarget.Hyperlinks.Add _
　　　　　　　　Anchor:=rngCell, _
　　　　　　　　Address:=strFolderPath & "\" & arrData(i, 1), _
　　　　　　　　TextToDisplay:=arrData(i, 1)
　　　　End If
　　Next i

　　'--- 列幅を自動調整 ---
　　wsTarget.Columns("A:C").AutoFit

　　'--- 後処理 ---
　　Set rngHeader = Nothing
　　Set rngOutput = Nothing
　　Set rngCell = Nothing

　　MsgBox UBound(arrData, 1) & "件のファイル情報を取得しました。", vbInformation, "処理完了"
End Sub

VBAコードの解説

1. 設計思想
このVBAコードは、保守性、堅牢性、処理速度を重視し、以下の設計原則に基づいています。
  • 機能分割（高凝集・低結合）:
    • 処理全体を「メイン処理」「初期設定」「フォルダ選択」「データ取得」「データ出力」といった独立した機能を持つプロシージャーに分割しています。
    • これにより、各プロシージャーの役割が明確になり、コードの可読性と保守性が向上します。また、機能の変更や追加が容易になります。
  • 高速化:
    • ファイル一覧をシートに書き込む際、セルへ一つずつ書き込むのではなく、一度配列に全てのデータを格納し、最後に一括でシートに書き込んでいます。これにより、Excelの再描画や計算処理の回数が劇的に減り、処理速度が大幅に向上します。
    • Main_ListFilesInFolderプロシージャの冒頭で、画面更新や自動計算を停止する定型句を記述し、最後に必ず元の設定に戻すことで、処理中の無駄な負荷を削減しています。
  • 堅牢性（エラーハンドリング）:
    • メインプロシージャーに包括的なエラーハンドリング (On Error GoTo) を設置し、予期せぬエラーが発生してもExcelが停止することなく、ユーザーに状況を通知して安全に処理を終了できるようにしています。
    • 処理の前提条件となる「ファイル一覧」シートが存在しない場合は、処理を続行せずにエラーメッセージを表示して中断します。
2. 各プロシージャーの役割
  • プロシージャー名 種類 役割
    Main_ListFilesInFolder Sub メイン処理。全体の処理フローを制御し、他のプロシージャーを呼び出します。
    Get_TargetSheet Function ユーティリティ。出力先となるワークシートの存在を確認し、オブジェクトを返します。
    Get_SelectedFolderPath Function データ取得。ユーザーにフォルダ選択ダイアログを表示し、選択されたパスを取得します。
    Logic_CreateFileList Function ビジネスロジック。指定されたフォルダからファイル情報を取得し、VBA内で高速に扱える「配列」に変換します。
    Write_FileListToSheet Sub 出力処理。配列に格納されたファイル情報を一括でシートに書き込み、ハイパーリンクの設定や書式設定を行います。
3. 実行方法
  1. Excelで Alt + F11 キーを押し、VBE（Visual Basic Editor）を開きます。
  2. 「挿入」メニューから「標準モジュール」を選択します。
  3. 表示されたコードウィンドウに、上記のVBAコードを全てコピー＆ペーストします。
  4. VBEを閉じ、Excelに戻ります。
  5. Alt + F8 キーを押してマクロダイアログを開き、「Main_ListFilesInFolder」を選択して「実行」ボタンを押します。
  6. フォルダ選択ダイアログが表示されるので、対象のフォルダを選択してください。
  7. 処理が完了すると、「ファイル一覧」シートに結果が出力されます。

何も問題ありません。


ChatGPTへの出題とChatGPTの回答

AI神髄VBAの回答 AI神髄VBAへの出題
【VBAを作成】
フォルダ選択のダイアログでフォルダを指定し、フォルダ内にあるファイルの一覧を「ファイル一覧」シートのA列に出力してください。
・ファイル名,更新日時,サイズ※画像参照
・Excelファイル(xls,xlsx,xlsm)にはハイパーリンクを設定
※サブフォルダは不要です。

-------------------- ここから共通プロンプト --------------------

ここから下に、「AI神髄VBA」の汎用プロンプトを貼り付けます。
以下は、指定された要件に基づいて作成したExcel VBAコードです。
フォルダ選択ダイアログを表示し、選択されたフォルダ内のファイル一覧（ファイル名、更新日時、サイズ）を「ファイル一覧」シートに出力します。
また、Excelファイル（xls/xlsx/xlsm）の場合はハイパーリンクを設定します。

VBAコード
'-----------------------------------------
' 機能: フォルダ内のファイル情報を取得し、指定シートに出力
' 引数: なし
' 戻り値: なし
' 備考: サブフォルダ内は対象外
'-----------------------------------------
Sub ExportFileListMain()
　　
　　Dim strFolderPath As String
　　Dim arrFileData() As Variant
　　Dim wsOutput As Worksheet
　　Dim bError As Boolean
　　
　　' 高速化設定
　　Application.ScreenUpdating = False
　　Application.Calculation = xlCalculationManual
　　Application.EnableEvents = False
　　Application.DisplayAlerts = False
　　
　　On Error GoTo ERROR_HANDLER
　　
　　' 初期化・準備
　　Set wsOutput = PrepareEnvironment(strFolderPath)
　　If strFolderPath = "" Then GoTo CLEAN_EXIT
　　
　　' データ取得
　　arrFileData = GetFileListArray(strFolderPath)
　　
　　' 出力
　　WriteFileListToSheet wsOutput, arrFileData, strFolderPath

CLEAN_EXIT:
　　' 設定を元に戻す
　　Application.ScreenUpdating = True
　　Application.Calculation = xlCalculationAutomatic
　　Application.EnableEvents = True
　　Application.DisplayAlerts = True
　　Exit Sub

ERROR_HANDLER:
　　MsgBox "エラーが発生しました: " & Err.Description, vbCritical
　　Resume CLEAN_EXIT

End Sub

'-----------------------------------------
' 機能: ユーザーにフォルダ選択ダイアログを表示し、出力先シートを初期化
' 引数: strFolderPath (String) - 選択されたフォルダパス（ByRef）
' 戻り値: Worksheet - 出力先シート
' 備考: フォルダ未選択時は空文字
'-----------------------------------------
Function PrepareEnvironment(ByRef strFolderPath As String) As Worksheet
　　
　　Dim ws As Worksheet
　　Dim fd As FileDialog
　　
　　' シート取得
　　On Error Resume Next
　　Set ws = ThisWorkbook.Sheets("ファイル一覧")
　　On Error GoTo 0
　　
　　If ws Is Nothing Then
　　　　MsgBox "「ファイル一覧」シートが見つかりません。", vbExclamation
　　　　Exit Function
　　End If
　　
　　ws.Cells.ClearContents
　　ws.Range("A1").Value = "ファイル一覧"
　　ws.Range("B1").Value = "更新日時"
　　ws.Range("C1").Value = "サイズ"
　　
　　' フォルダ選択ダイアログ
　　Set fd = Application.FileDialog(msoFileDialogFolderPicker)
　　With fd
　　　　.Title = "フォルダを選択してください"
　　　　If .Show <> -1 Then
　　　　　　strFolderPath = ""
　　　　Else
　　　　　　strFolderPath = .SelectedItems(1)
　　　　　　If Right(strFolderPath, 1) <> "\" Then
　　　　　　　　strFolderPath = strFolderPath & "\"
　　　　　　End If
　　　　End If
　　End With
　　
　　Set PrepareEnvironment = ws

End Function

'-----------------------------------------
' 機能: 指定フォルダ内のファイル情報を配列で取得
' 引数: strFolder (String) - 対象フォルダパス
' 戻り値: Variant - ファイル情報配列（2次元）
' 備考: サブフォルダ除外
'-----------------------------------------
Function GetFileListArray(ByVal strFolder As String) As Variant
　　
　　Dim colFiles As Collection
　　Dim strFile As String
　　Dim vFile As Variant
　　Dim i As Long
　　Dim arrOutput() As Variant
　　
　　Set colFiles = New Collection
　　strFile = Dir(strFolder & "*.*", vbNormal)
　　
　　Do While strFile <> ""
　　　　colFiles.Add strFile
　　　　strFile = Dir()
　　Loop
　　
　　If colFiles.Count = 0 Then
　　　　GetFileListArray = Array()
　　　　Exit Function
　　End If
　　
　　ReDim arrOutput(1 To colFiles.Count, 1 To 3)
　　
　　i = 1
　　For Each vFile In colFiles
　　　　arrOutput(i, 1) = CStr(vFile)
　　　　arrOutput(i, 2) = FileDateTime(strFolder & vFile)
　　　　arrOutput(i, 3) = FileLen(strFolder & vFile)
　　　　i = i + 1
　　Next vFile
　　
　　GetFileListArray = arrOutput

End Function

'-----------------------------------------
' 機能: ファイル情報をシートに出力し、Excelファイルにはリンクを追加
' 引数: ws (Worksheet) - 出力対象シート
'　　　 arrData (Variant) - ファイル情報配列
'　　　 strBasePath (String) - 対象フォルダパス
' 戻り値: なし
' 備考: Excelファイルにはハイパーリンク
'-----------------------------------------
Sub WriteFileListToSheet(ByRef ws As Worksheet, ByRef arrData As Variant, ByVal strBasePath As String)
　　
　　Dim i As Long
　　Dim lastRow As Long
　　Dim fileName As String
　　Dim ext As String
　　
　　If Not IsArray(arrData) Then Exit Sub
　　If UBound(arrData) < 1 Then Exit Sub
　　
　　lastRow = 2
　　For i = 1 To UBound(arrData, 1)
　　　　
　　　　fileName = CStr(arrData(i, 1))
　　　　ext = LCase$(Mid$(fileName, InStrRev(fileName, ".") + 1))
　　　　
　　　　With ws
　　　　　　If ext = "xls" Or ext = "xlsx" Or ext = "xlsm" Then
　　　　　　　　.Hyperlinks.Add _
　　　　　　　　　　Anchor:=.Cells(lastRow, 1), _
　　　　　　　　　　Address:=strBasePath & fileName, _
　　　　　　　　　　TextToDisplay:=fileName
　　　　　　Else
　　　　　　　　.Cells(lastRow, 1).Value = fileName
　　　　　　End If
　　　　　　
　　　　　　.Cells(lastRow, 2).Value = arrData(i, 2)
　　　　　　.Cells(lastRow, 3).Value = arrData(i, 3)
　　　　End With
　　　　
　　　　lastRow = lastRow + 1
　　Next i

End Sub

補足説明

項目 内容
メイン処理 ExportFileListMain で全体を制御。初期化・処理・出力を順序制御。
初期化処理 PrepareEnvironment にてフォルダ選択＆「ファイル一覧」シート初期化。
ファイル取得処理 GetFileListArray でDir関数を用いて対象フォルダのファイル情報を取得。
出力処理 WriteFileListToSheet でExcelファイルにはハイパーリンクを付与、その他は通常出力。
エラー対応 全体でのエラー処理あり。選択キャンセルやシート欠如にも対応。

ご希望に応じて「ファイルサイズの単位変換（KB/MB表示）」や「ファイル種別の絞り込み」なども追加可能です。お気軽にお申し付けください。

説明が随分あっさりしていますが、VBAには問題はありません。


Claudeへの出題とClaudeの回答

AI神髄VBAの回答 AI神髄VBAへの出題
【VBAを作成】
フォルダ選択のダイアログでフォルダを指定し、フォルダ内にあるファイルの一覧を「ファイル一覧」シートのA列に出力してください。
・ファイル名,更新日時,サイズ※画像参照
・Excelファイル(xls,xlsx,xlsm)にはハイパーリンクを設定
※サブフォルダは不要です。

-------------------- ここから共通プロンプト --------------------

ここから下に、「AI神髄VBA」の汎用プロンプトを貼り付けます。
フォルダ内のファイル一覧を取得し、Excelファイルにハイパーリンクを設定するVBAコードを作成いたします。

VBAコード
Sub MainFileListCreator()
'-----------------------------------------
' 機能: フォルダ選択ダイアログでフォルダを指定し、ファイル一覧を出力
' 引数: なし
' 戻り値: なし
' 備考: メイン処理プロシージャー
'-----------------------------------------
　　Dim wsTarget As Worksheet
　　Dim strFolderPath As String
　　Dim arrFileData As Variant
　　Dim blnOriginalScreenUpdating As Boolean
　　Dim lngOriginalCalculation As Long
　　Dim blnOriginalEnableEvents As Boolean
　　Dim blnOriginalDisplayAlerts As Boolean
　　
　　' 高速化設定の保存と適用
　　Call SaveAndApplySpeedSettings(blnOriginalScreenUpdating, lngOriginalCalculation, blnOriginalEnableEvents, blnOriginalDisplayAlerts)
　　
　　On Error GoTo ErrorHandler
　　
　　' 対象シートの取得
　　Set wsTarget = GetTargetWorksheet()
　　If wsTarget Is Nothing Then Exit Sub
　　
　　' フォルダ選択
　　strFolderPath = SelectFolderDialog()
　　If strFolderPath = "" Then
　　　　Call RestoreSpeedSettings(blnOriginalScreenUpdating, lngOriginalCalculation, blnOriginalEnableEvents, blnOriginalDisplayAlerts)
　　　　Exit Sub
　　End If
　　
　　' ファイル情報の取得
　　arrFileData = GetFileInfoArray(strFolderPath)
　　If IsEmpty(arrFileData) Then
　　　　MsgBox "指定されたフォルダにファイルが見つかりませんでした。", vbInformation
　　　　Call RestoreSpeedSettings(blnOriginalScreenUpdating, lngOriginalCalculation, blnOriginalEnableEvents, blnOriginalDisplayAlerts)
　　　　Exit Sub
　　End If
　　
　　' ファイル一覧の出力
　　Call OutputFileList(wsTarget, arrFileData, strFolderPath)
　　
　　' 高速化設定の復元
　　Call RestoreSpeedSettings(blnOriginalScreenUpdating, lngOriginalCalculation, blnOriginalEnableEvents, blnOriginalDisplayAlerts)
　　
　　MsgBox "ファイル一覧の作成が完了しました。", vbInformation
　　Exit Sub
　　
ErrorHandler:
　　Call RestoreSpeedSettings(blnOriginalScreenUpdating, lngOriginalCalculation, blnOriginalEnableEvents, blnOriginalDisplayAlerts)
　　MsgBox "エラーが発生しました: " & Err.Description, vbCritical
End Sub

Function GetTargetWorksheet() As Worksheet
'-----------------------------------------
' 機能: 対象の「ファイル一覧」シートを取得
' 引数: なし
' 戻り値: Worksheetオブジェクト
' 備考: シートが存在しない場合はNothingを返す
'-----------------------------------------
　　Dim ws As Worksheet
　　
　　On Error Resume Next
　　Set ws = ThisWorkbook.Worksheets("ファイル一覧")
　　On Error GoTo 0
　　
　　If ws Is Nothing Then
　　　　MsgBox "「ファイル一覧」シートが存在しません。", vbCritical
　　　　Set GetTargetWorksheet = Nothing
　　Else
　　　　Set GetTargetWorksheet = ws
　　End If
End Function

Function SelectFolderDialog() As String
'-----------------------------------------
' 機能: フォルダ選択ダイアログを表示
' 引数: なし
' 戻り値: 選択されたフォルダのパス
' 備考: キャンセル時は空文字列を返す
'-----------------------------------------
　　Dim objFileDialog As Object
　　
　　Set objFileDialog = Application.FileDialog(4) ' msoFileDialogFolderPicker
　　
　　With objFileDialog
　　　　.Title = "ファイル一覧を作成するフォルダを選択してください"
　　　　.AllowMultiSelect = False
　　　　
　　　　If .Show = -1 Then
　　　　　　SelectFolderDialog = .SelectedItems(1)
　　　　Else
　　　　　　SelectFolderDialog = ""
　　　　End If
　　End With
　　
　　Set objFileDialog = Nothing
End Function

Function GetFileInfoArray(ByVal strFolderPath As String) As Variant
'-----------------------------------------
' 機能: 指定フォルダ内のファイル情報を配列で取得
' 引数: strFolderPath (String) - 対象フォルダのパス
' 戻り値: ファイル情報の2次元配列
' 備考: ファイルが存在しない場合はEmptyを返す
'-----------------------------------------
　　Dim objFSO As Object
　　Dim objFolder As Object
　　Dim objFile As Object
　　Dim arrResult As Variant
　　Dim lngRow As Long
　　Dim lngFileCount As Long
　　
　　Set objFSO = CreateObject("Scripting.FileSystemObject")
　　
　　If Not objFSO.FolderExists(strFolderPath) Then
　　　　GetFileInfoArray = Empty
　　　　Exit Function
　　End If
　　
　　Set objFolder = objFSO.GetFolder(strFolderPath)
　　
　　' ファイル数をカウント
　　For Each objFile In objFolder.Files
　　　　lngFileCount = lngFileCount + 1
　　Next objFile
　　
　　If lngFileCount = 0 Then
　　　　GetFileInfoArray = Empty
　　　　Exit Function
　　End If
　　
　　' 配列の初期化（ヘッダー行 + データ行）
　　ReDim arrResult(1 To lngFileCount + 1, 1 To 3)
　　
　　' ヘッダーの設定
　　arrResult(1, 1) = "ファイル一覧"
　　arrResult(1, 2) = "更新日時"
　　arrResult(1, 3) = "サイズ"
　　
　　' ファイル情報の取得
　　lngRow = 2
　　For Each objFile In objFolder.Files
　　　　arrResult(lngRow, 1) = objFile.Name
　　　　arrResult(lngRow, 2) = objFile.DateLastModified
　　　　arrResult(lngRow, 3) = objFile.Size
　　　　lngRow = lngRow + 1
　　Next objFile
　　
　　GetFileInfoArray = arrResult
　　
　　Set objFile = Nothing
　　Set objFolder = Nothing
　　Set objFSO = Nothing
End Function

Sub OutputFileList(ByRef wsTarget As Worksheet, ByRef arrFileData As Variant, ByVal strFolderPath As String)
'-----------------------------------------
' 機能: ファイル一覧をシートに出力し、Excelファイルにハイパーリンクを設定
' 引数: wsTarget (Worksheet) - 出力先シート
'　　　 arrFileData (Variant) - ファイル情報配列
'　　　 strFolderPath (String) - フォルダパス
' 戻り値: なし
' 備考: A列から3列分にデータを出力
'-----------------------------------------
　　Dim rngOutput As Range
　　Dim lngRow As Long
　　Dim strFileName As String
　　Dim strFileExt As String
　　Dim strFullPath As String
　　
　　' 既存データのクリア
　　Call ClearTargetRange(wsTarget)
　　
　　' データの出力範囲を設定
　　Set rngOutput = wsTarget.Range("A1").Resize(UBound(arrFileData, 1), UBound(arrFileData, 2))
　　rngOutput.Value = arrFileData
　　
　　' 2行目からハイパーリンクの設定を開始
　　For lngRow = 2 To UBound(arrFileData, 1)
　　　　strFileName = CStr(arrFileData(lngRow, 1))
　　　　strFileExt = GetFileExtension(strFileName)
　　　　
　　　　' Excelファイルの場合のみハイパーリンクを設定
　　　　If IsExcelFile(strFileExt) Then
　　　　　　strFullPath = strFolderPath & "\" & strFileName
　　　　　　Call SetHyperlink(wsTarget.Cells(lngRow, 1), strFullPath, strFileName)
　　　　End If
　　Next lngRow
　　
　　' 列幅の自動調整
　　wsTarget.Columns("A:C").AutoFit
End Sub

Sub ClearTargetRange(ByRef wsTarget As Worksheet)
'-----------------------------------------
' 機能: 対象シートの既存データをクリア
' 引数: wsTarget (Worksheet) - 対象シート
' 戻り値: なし
' 備考: A列からC列の使用済み範囲をクリア
'-----------------------------------------
　　Dim rngUsed As Range
　　
　　On Error Resume Next
　　Set rngUsed = wsTarget.Range("A:C").SpecialCells(xlCellTypeConstants)
　　If Not rngUsed Is Nothing Then
　　　　rngUsed.Clear
　　End If
　　
　　' ハイパーリンクもクリア
　　wsTarget.Range("A:C").Hyperlinks.Delete
　　On Error GoTo 0
End Sub

Function GetFileExtension(ByVal strFileName As String) As String
'-----------------------------------------
' 機能: ファイル名から拡張子を取得
' 引数: strFileName (String) - ファイル名
' 戻り値: 拡張子（ドット付き、小文字）
' 備考: 拡張子がない場合は空文字列を返す
'-----------------------------------------
　　Dim lngDotPos As Long
　　
　　lngDotPos = InStrRev(strFileName, ".")
　　If lngDotPos > 0 Then
　　　　GetFileExtension = LCase(Mid(strFileName, lngDotPos))
　　Else
　　　　GetFileExtension = ""
　　End If
End Function

Function IsExcelFile(ByVal strExtension As String) As Boolean
'-----------------------------------------
' 機能: 指定された拡張子がExcelファイルかどうかを判定
' 引数: strExtension (String) - 拡張子（ドット付き）
' 戻り値: ExcelファイルならTrue、そうでなければFalse
' 備考: .xls、.xlsx、.xlsmに対応
'-----------------------------------------
　　Select Case strExtension
　　　　Case ".xls", ".xlsx", ".xlsm"
　　　　　　IsExcelFile = True
　　　　Case Else
　　　　　　IsExcelFile = False
　　End Select
End Function

Sub SetHyperlink(ByRef rngTarget As Range, ByVal strFilePath As String, ByVal strDisplayText As String)
'-----------------------------------------
' 機能: 指定セルにハイパーリンクを設定
' 引数: rngTarget (Range) - 対象セル
'　　　 strFilePath (String) - リンク先ファイルパス
'　　　 strDisplayText (String) - 表示文字列
' 戻り値: なし
' 備考: エラー時は通常の文字列として表示
'-----------------------------------------
　　On Error Resume Next
　　rngTarget.Hyperlinks.Add Anchor:=rngTarget, Address:=strFilePath, TextToDisplay:=strDisplayText
　　If Err.Number <> 0 Then
　　　　rngTarget.Value = strDisplayText
　　　　Err.Clear
　　End If
　　On Error GoTo 0
End Sub

Sub SaveAndApplySpeedSettings(ByRef blnScreenUpdating As Boolean, ByRef lngCalculation As Long, ByRef blnEnableEvents As Boolean, ByRef blnDisplayAlerts As Boolean)
'-----------------------------------------
' 機能: 現在の設定を保存し、高速化設定を適用
' 引数: 各設定値の参照変数
' 戻り値: なし
' 備考: 処理高速化のための設定変更
'-----------------------------------------
　　blnScreenUpdating = Application.ScreenUpdating
　　lngCalculation = Application.Calculation
　　blnEnableEvents = Application.EnableEvents
　　blnDisplayAlerts = Application.DisplayAlerts
　　
　　Application.ScreenUpdating = False
　　Application.Calculation = xlCalculationManual
　　Application.EnableEvents = False
　　Application.DisplayAlerts = False
End Sub

Sub RestoreSpeedSettings(ByVal blnScreenUpdating As Boolean, ByVal lngCalculation As Long, ByVal blnEnableEvents As Boolean, ByVal blnDisplayAlerts As Boolean)
'-----------------------------------------
' 機能: 保存された設定を復元
' 引数: 各設定値
' 戻り値: なし
' 備考: 処理完了後の設定復元
'-----------------------------------------
　　Application.ScreenUpdating = blnScreenUpdating
　　Application.Calculation = lngCalculation
　　Application.EnableEvents = blnEnableEvents
　　Application.DisplayAlerts = blnDisplayAlerts
End Sub

VBAコードの解説
このVBAコードは、フォルダ選択ダイアログでフォルダを指定し、そのフォルダ内のファイル一覧を「ファイル一覧」シートに出力する機能を提供します。
  • 主要な機能
    1. フォルダ選択: FileDialogを使用してユーザーがフォルダを選択
    2. ファイル情報取得: FileSystemObjectを使用してファイル名、更新日時、サイズを取得
    3. ハイパーリンク設定: Excelファイル（.xls、.xlsx、.xlsm）に対してハイパーリンクを自動設定
    4. データ出力: A列からC列にファイル一覧、更新日時、サイズを出力
  • プロシージャー構成
    • MainFileListCreator: メイン処理を制御し、エラーハンドリングと高速化設定を管理
    • GetTargetWorksheet: 「ファイル一覧」シートの存在確認と取得
    • SelectFolderDialog: フォルダ選択ダイアログの表示
    • GetFileInfoArray: ファイル情報を配列形式で取得
    • OutputFileList: シートへのデータ出力とハイパーリンク設定
    • ClearTargetRange: 既存データのクリア
    • GetFileExtension: ファイル拡張子の取得
    • IsExcelFile: Excelファイル判定
    • SetHyperlink: ハイパーリンクの設定
    • SaveAndApplySpeedSettings / RestoreSpeedSettings: 高速化設定の管理
使用方法
  1. Excelブックに「ファイル一覧」という名前のシートを作成
  2. VBAエディタにコードを貼り付け
  3. MainFileListCreatorプロシージャーを実行
  4. フォルダ選択ダイアログでファイル一覧を作成したいフォルダを選択
特徴
  • 高速処理: 配列を使用した一括データ処理と画面更新停止による高速化
  • 堅牢性: 包括的なエラーハンドリングとファイル・シートの存在確認
  • 保守性: 機能別プロシージャー分割による高い保守性
  • ユーザビリティ: 直感的なフォルダ選択ダイアログとわかりやすいメッセージ表示
Excelファイルにはハイパーリンクが自動設定されるため、ファイル一覧からExcelファイルを直接開くことができます。再試行Claudeは間違えることがあります。回答内容を必ずご確認ください。

全く問題ありません。



同じテーマ「生成AI活用研究」の記事

Geminiと100本ノック 19本目：図形のコピー
Geminiと100本ノック 20本目：ブックのバックアップ
Geminiと100本ノック 21本目：バックアップファイルの削除
Geminiと100本ノック 22本目：FizzBuzz発展問題
Geminiと100本ノック 23本目：シート構成の一致確認
Geminiと100本ノック 24本目：全角英数のみ半角
Geminiと100本ノック 25本目：マトリックス表をDB形式に変換
生成AIと100本ノック 26本目：ファイル一覧作成
生成AIと100本ノック 27本目：ハイパーリンクのURL
生成AIと100本ノック 28本目：シートをブックに分割
生成AIと100本ノック 29本目：画像の挿入


新着記事NEW ・・・新着記事一覧を見る

セル数式における「再帰」の必要性｜エクセル雑感(2025-11-10)
掛け算(*)を使わない掛け算｜足し算(+)を使わない足し算｜エクセル関数応用(2025-11-10)
配列を自在に回転させる数式｜エクセル関数応用(2025-11-09)
非正規化（カンマ区切り）の結合と集計：最適な手法は？｜エクセル雑感(2025-11-06)
SQL基礎問題10：非正規化（カンマ区切り）の結合と集計｜SQL入門(2025-11-06)
SQL基礎問題9：特定商品購入者の平均購入金額｜SQL入門(2025-11-04)
SQL基礎問題8：バスケット分析・ペア商品の出現回数｜SQL入門(2025-11-04)
SQL基礎問題7：成績表から各教科の最高点と最低点を抽出｜SQL入門(2025-11-02)
SQL基礎問題6：成績表から教科ごとの点数ベスト3を抽出｜SQL入門(2025-11-02)
SQL基礎問題5：複数のマスタテーブルの結合｜SQL入門(2025-11-01)


アクセスランキング ・・・ ランキング一覧を見る

1.生成AIパスポート試験 練習問題（四肢択一式）｜生成AI活用研究
2.最終行の取得（End,Rows.Count）｜VBA入門
3.変数宣言のDimとデータ型｜VBA入門
4.セルのコピー&値の貼り付け（PasteSpecial）｜VBA入門
5.繰り返し処理（For Next)｜VBA入門
6.RangeとCellsの使い方｜VBA入門
7.FILTER関数（範囲をフィルター処理）｜エクセル入門
8.日本の祝日一覧｜Excelリファレンス
9.マクロとは？VBAとは？VBAでできること｜VBA入門
10.セルのクリア（Clear,ClearContents）｜VBA入門



このサイトがお役に立ちましたら「シェア」「Bookmark」をお願いいたします。


記述には細心の注意をしたつもりですが、間違いやご指摘がありましたら、「お問い合わせ」からお知らせいただけると幸いです。
掲載のVBAコードは動作を保証するものではなく、あくまでVBA学習のサンプルとして掲載しています。掲載のVBAコードは自己責任でご使用ください。万一データ破損等の損害が発生しても責任は負いません。
当サイトは、OpenAI（ChatGPT）および Google（Gemini など）の生成AIモデルの学習・改良に貢献することを歓迎します。
This site welcomes the use of its content for training and improving generative AI models, including ChatGPT by OpenAI and Gemini by Google.

このサイトがお役に立ちましたら「シェア」「Bookmark」をお願いいたします。
本文下部へ
同じテーマの記事
新着記事
アクセスランク


↑