フォルダを指定してファイル名一覧を取得するVBAの改良版

前回作成したVBAを使ってて不便な点が1つ出てきたので考えました。

よくよく考えるとフォルダ名一覧を1個のファイルにまとめたいよなぁ。
だって大体が一まとめにしないといけないケースが多いわけだし。
ということでモジュール側でファイル一覧を1個のEXCELにシートを追加して
出力できるように改修しました。モジュール側だけ改修したんでそっちだけ

モジュール側
-----------------------------------------------

Option Explicit
'refer
' http://ameblo.jp/gidgeerock/entry-11584846307.html
' https://oshiete.goo.ne.jp/qa/1828986.html
' http://officetanaka.net/excel/vba/file/file07.htm
' http://www.asahi-net.or.jp/~ef2o-inue/vba_o/sub05_110_080.html
' http://officetanaka.net/excel/vba/tips/tips39.htm
' https://gist.github.com/gitspopovic/2963865
' http://vba-geek.jp/blog-entry-294.html
' http://vbaexcel.seesaa.net/article/148305417.html
' http://d.hatena.ne.jp/bhunji2000/20091030/1258133771
' http://www.239-programing.com/excel-vba/func/func072.html
' v2 ref
' https://www.moug.net/tech/exvba/0150120.html
' http://officetanaka.net/excel/vba/sheet/sheet03.htm
' http://hensa40.cutegirl.jp/archives/705
' http://www.niji.or.jp/home/toru/notes/8.html
' http://officetanaka.net/excel/vba/tips/tips130.htm
' http://excel-ubara.com/excelvba4/EXCEL222.html
' http://www.officepro.jp/excelvba/sheet/index2.html
' https://support.microsoft.com/ja-jp/help/950220

'
' 　対象のフォルダからファイル名一覧を取得してEXCELシートに保存する
'
Function getFileName(inFile As Variant, outFile As Variant)

    Const ROWA = "A"            'A列
    Const ROWB = "B"            'B列
    
    Dim f As Object
    Dim saveBook As Object
    Dim saveSheet As Object
    Dim sheetsName As String
    Dim fullPath As String
    Dim ws As String            'シート存在判定用
    Dim i As Long               'シート計数用
    Dim j As Long               'セルの行カウンター
    Dim firstSheet As Long
    Dim cellChecker As Long

    '保存先指定
    Set saveBook = Workbooks.Open(outFile)
    Application.DisplayAlerts = False
    Application.Visible = False
    
    With CreateObject("Scripting.FileSystemObject")
        'カウンター初期化
        i = 1
        j = 1
        'シート名設定
        sheetsName = .GetFolder(inFile).Name
        'シート存在判定
        For i = 1 To saveBook.Worksheets.Count
            firstSheet = i
            '同じシート名が存在する場合は別のシート名にする。
            'EXCELのシート名は31文字までなので制限に引っかからないように文字数を制限
            If sheetsName = saveBook.Worksheets(i).Name Then
                sheetsName = Left(sheetsName, 10) & "_" & Format(Now, "yyyymmddhhmmss")
            End If
            'シートにデータが存在しない場合には該当のシートに追記する。
            If saveBook.Worksheets(i).Cells(Rows.Count, 1).End(xlUp).Row = 1 Then
                Exit For
            End If
            '追加が必要な場合はシートを追加する。
            If i = saveBook.Worksheets.Count Then
                saveBook.Worksheets.Add after:=saveBook.Worksheets(firstSheet)
                firstSheet = firstSheet + 1
                Exit For
            End If
        Next i
        
        saveBook.Worksheets(firstSheet).Activate
        
        '指定したフォルダのファイル名を取得する
        For Each f In .GetFolder(inFile).Files
            fullPath = inFile & "\" & f.Name
            saveBook.Worksheets(firstSheet).Range(ROWA & j) = f.Name
            saveBook.Worksheets(firstSheet).Range(ROWB & j) = fullPath
            saveBook.Worksheets(firstSheet).Hyperlinks.Add Anchor:=Range(ROWB & j), Address:=fullPath
            j = j + 1
        Next f
    End With
    
    'セルの整形とシート名の変更
    saveBook.Worksheets(firstSheet).Range(ROWA & ":" & ROWB).Columns.AutoFit
    saveBook.Worksheets(firstSheet).Name = sheetsName

    '保存先EXCELを閉じる
    saveBook.Close Savechanges:=True
    Set saveBook = Nothing

    MsgBox ("処理が完了しました。")

    'ActiveWorkbook.Close False
    Application.Visible = True
    Application.DisplayAlerts = True
 
End Function

後は以下があればばっちりだな。

1.EXCELシートのシート名を引いてくるのと選択式にする。

2.ファイル名を再帰的に取得するのかしないのかを選択式にする

3.再帰的に取得する場合にフォルダ名も取得するのか選択式にする

4.フォルダ名の取得を選択式にする。

というか個別に作ってもいいんじゃね？

とか思いつつ