VBA100本ノック 26本目：ファイル一覧作成

この記事から得るもの

ユーザーが選択したフォルダの中のファイル一覧をSheetに作成する。
そして、エクセル（拡張子.xls、.xlsx、,xlsm）のファイルであればハイパーリンクを設定して直接開けるようにする。

１　今回のお題

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

f:id:bimori466:20201123084552p:plain

excel-ubara.com

２　今回のお題の意図

エクセルBookにハイパーリンクを付与して楽にファイルを見れるようにする。

３　回答

私の最初の回答

Sub ノック26本目_1()

Dim ws As Worksheet: Set ws = Worksheets("ファイル一覧")
Dim fso As Object: Set fso = CreateObject("scripting.filesystemobject")
Dim FilePath As String: FilePath = ThisWorkbook.Path & "\"
Dim myFile As Object: Dim myFolders As Object
Dim Write_IX As Long: Write_IX = 1

Set myFolders = fso.GetFolder(FilePath) 'フォルダ取得

ws.Range("A1").CurrentRegion.Offset(1).ClearContents  'データ削除

'ファイル名取得処理
For Each myFile In myFolders.Files
    If Not myFile.Name Like "~$*" Then
        '書き込み処理
        Write_IX = Write_IX + 1
        ws.Cells(Write_IX, 1) = myFile.Name             'ファイル名
        
        'ハイパーリンクの設定
        If myFile.Name Like "*.xls" Or myFile.Name Like "*.xlsx" Or myFile.Name Like "*.xlsm" Then
            ws.Hyperlinks.Add Anchor:=Cells(Write_IX, 1), Address:=myFile.Path
        End If
        
        ws.Cells(Write_IX, 2) = myFile.DateLastModified '更新日時
        ws.Cells(Write_IX, 3) = myFile.Size             'ファイルサイズ
        
    End If
Next


'サブフォルダの取得
For Each myFile In myFolders.subfolders
    '書き込み処理
    Write_IX = Write_IX + 1
    ws.Cells(Write_IX, 1) = myFile.Name             'ファイル名
    ws.Cells(Write_IX, 2) = myFile.DateLastModified '更新日時
    ws.Cells(Write_IX, 3) = myFile.Size             'ファイルサイズ
Next


End Sub

勉強になったのは、ハイパーリンクの設定方法です。
「 ws.Hyperlinks.Add Anchor:=Cells(Write_IX, 1), Address:=myFile.Path」
つまり、「Sheet.Add Anchor:=セル,Address:=”URL”」とすればハイパーリンクの設定が完了します。

しかし、ひとつ問題点があります。お題の「フォルダ選択のダイアログでフォルダを指定し」の部分に応えられていません。Pathを直接指定していました。

私の最終回答

Sub ノック26本目_2()

Dim ws As Worksheet: Set ws = Worksheets("ファイル一覧")
Dim fso As Object: Set fso = CreateObject("scripting.filesystemobject")
Dim FilePath As String: Dim myFile As Object: Dim myFolders As Object
Dim Write_IX As Long: Write_IX = 1

'フォルダを選択して取得
With Application.FileDialog(msoFileDialogFolderPicker)
    .InitialFileName = ws.Parent.Path & "\"
    If Not .Show Then Exit Sub
    FilePath = .SelectedItems(1) & "\"
End With

Set myFolders = fso.GetFolder(FilePath) 'フォルダ取得

ws.Range("A1").CurrentRegion.Offset(1).ClearContents  'データ削除

'ファイル名取得処理
For Each myFile In myFolders.Files
    If Not myFile.Name Like "~$*" Then
        '書き込み処理
        Write_IX = Write_IX + 1
        ws.Cells(Write_IX, 1) = myFile.Name             'ファイル名
        
        'ハイパーリンクの設定
        If myFile.Name Like "*.xls" Or myFile.Name Like "*.xlsx" Or myFile.Name Like "*.xlsm" Then
            ws.Hyperlinks.Add Anchor:=Cells(Write_IX, 1), Address:=myFile.Path
        End If
        
        ws.Cells(Write_IX, 2) = myFile.DateLastModified '更新日時
        ws.Cells(Write_IX, 3) = myFile.Size             'ファイルサイズ
        
    End If
Next


'サブフォルダの取得
For Each myFile In myFolders.subfolders
    '書き込み処理
    Write_IX = Write_IX + 1
    ws.Cells(Write_IX, 1) = myFile.Name             'ファイル名
    ws.Cells(Write_IX, 2) = myFile.DateLastModified '更新日時
    ws.Cells(Write_IX, 3) = myFile.Size             'ファイルサイズ
Next

End Sub

Application.FileDialogを使って、フォルダを選択します。初めて使ったので整理すると、
Application.FileDialog(msoFileDialogFolderPicker)は、ユーザーがフォルダを選択できる。
.InitialFileName = ws.Parent.Path & "\"は、ファイルのダイアログボックスに初期表示されるパスやファイル名を設定します。
.SelectedItemsは、FileDialog オブジェクトの Show メソッドによって表示されたファイルのダイアログボックスでユーザーが選択したファイルのパスの一覧が保存されています。

つまり、最初に表示できるファイルは設定できる。そしてそのPathを取得できるくらいの認識でよいかと思います。