HK29’s blog

PythonとVBAの備忘録

VBA フォルダパスをダイアログから取得する。更にそのフォルダ内のファイル名をソートして取得する

本記事では、ExcelVBAで複数のファイルを取得する方法について記載している。VBAで取得する場合、ファイル名に依っては下表左のように数字順に並ばない。これはWindowsファイルシステムがどうのこうので仕方なしのようである。よって、下表右のように昇順に並び替えるソート(Sort)方法についても記載した。

ソート前のファイル順 ソート後のファイル順
aaa_1.txt aaa_1.txt
aaa_10.txt aaa_2.txt
aaa_2.txt aaa_3.txt
aaa_20.txt aaa_10.txt
aaa_21.txt aaa_20.txt
aaa_3.txt aaa_21.txt

▼本プログラムを下記に示す。特記事項は二つあり、①フォルダパスの取得にFileSystemObjectを使用している点 ②ファイル名をソートするためにAPIを利用している点である。

①FileSystemObject(ファイルシステムオブジェクト)

フォルダやファイルを操作できるオブジェクトである。CreateObjectでインスタンスを作成して使用する。

API(エーピーアイ)

Windowsの標準機能の関数群のことでDLL内にある。コードの冒頭でDeclareで宣言して使用する。

Option Explicit
Public myPath As String 'フォルダパス名
'ソートのためのAPI読み出し宣言
Declare PtrSafe Function StrCmpLogicalW Lib "SHLWAPI.DLL" _
(ByVal lpStr1 As String, ByVal lpStr2 As String) As Long


Sub フォルダパスの取得()
    Dim myTxt, myFile As String

    myTxt = Application.GetOpenFilename(filefilter:="txt, *.txt")
    If myPath <> "false" Then
        With CreateObject("scripting.filesystemobject")
            myFile = .getfile(myTxt).Name
            myPath = .getfile(myTxt).parentfolder & "\"
        End With
    Else
        End
    End If
End Sub


Sub バブルソート_API(ByRef myArray() As String)
    Dim i, j As Long
    Dim tmp As String

    For i = LBound(myArray) To UBound(myArray)
        For j = i To UBound(myArray)
            If StrCmpLogicalW(StrConv(myArray(i), vbUnicode), StrConv(myArray(j), vbUnicode)) > 0 Then
                tmp = myArray(i)
                myArray(i) = myArray(j)
                myArray(j) = tmp
            End If
       Next j
    Next i
End Sub


Sub 本体プログラム()
    Dim buf As String, myFiles() As String
    Dim i, index, a As Integer
    Dim f As Variant

    'フォルダパス関数の取得
    Call フォルダパスの取得

    'ファイルを検索して配列へ格納
    i = 1
    Cells(i, 1) = "ソート前のファイル順"
    buf = Dir(myPath & "*.txt")    'ディレクトリ関数
    Do While buf <> ""
        i = i + 1
        ReDim Preserve myFiles(index)
            myFiles(index) = buf
        Cells(i, 1) = buf '読み込んだファイル名を順番にセルへ書き出し
        buf = Dir()
        index = index + 1
    Loop

    'ソート関数を読み出してソート
    Call バブルソート_API(myFiles)

    a = 1
    Cells(a, 2) = "ソート後のファイル順"
    For Each f In myFiles
        a = a + 1
        Cells(a, 2) = f 'ソート後のファイル名を順番にセルへ書き出し
    Next

End Sub

実用例は下記リンク先を参照

hk29.hatenablog.jp

以上