指定パス下にある指定ファイルの最新版を取得

昨日は指定パスにある指定ファイルの最新版を取得するために、全てのファイル名を取得しようとして失敗した。
infoment.hatenablog.com
なぜなら、「全てのファイル数」が数万にも及んでいたから。
１対数万では、効率が悪すぎる。そこで作戦を変えることにした。

作戦は、こうだ。

1. 正規表現を用い、ファイル名から保存パスを取得する。
2. 正規表現を用い、指定名を含むファイルの末尾にある英字を取得し、「文字コード」に変換してコレクションに格納する。
3. コレクションを配列に変換したうえで、その最大値を取得する（Max関数）。
4. 最大値を文字に戻して、ファイル名（来歴なし）の末尾に付し戻り値とする。

２．で一旦文字コードにしたのは、以下の方法がとれるから。

• Ａ ⇒ 文字コード：65
• Ｂ ⇒ 文字コード：66
• Ｃ ⇒ 文字コード：67

最大値は67だから、これを文字に戻して、ファイル名の末尾「Ｃ」が最新版であることが分かる。羅列したＡＢＣでは、比較の遣りようがない（実はある？）。

なお、下記は架空のコード体系であり、職場で使用しているものとは全くの別物であることを、改めて断っておく（従って、マクロも別物）。

まず標準モジュールに、大元のパスを準備する。
今回の例では、ＣドライブのTempフォルダとした。

Option Explicit
Public Const FileFolderPath = "C:\Temp"

次いで、クラスモジュールを一つ作成。名前は、"RevisionCheckClass"とした。

Option Explicit
Dim col As Collection
Dim FSO As FileSystemObject

クラスモジュールの初期化。

Private Sub Class_Initialize()
    Set col = New Collection
    Set FSO = New FileSystemObject
End Sub

今回の主となる部分（Microsoft VBScript Regular Expressions 5.5参照済み）。

Function GetFileRevision(file_name As String) As String

' -------------↓↓ファイル名から保存パスを取得する。↓↓-------------
    
    Dim myReg As RegExp
    Set myReg = New RegExp
        myReg.Pattern = "([A-Z]{3})(\d{4})([A-Z]?).*"

        If myReg.test(file_name) Then
            Dim MatchCase As MatchCollection
            Set MatchCase = myReg.Execute(file_name)
            Dim mySubMatches As SubMatches
            Set mySubMatches = MatchCase(0).SubMatches
        End If

    Dim InitialFileName As String
        InitialFileName = mySubMatches(0) & mySubMatches(1)

    Dim FolderSeq(2) As Variant
        FolderSeq(0) = FileFolderPath

        ' 部署を表す三桁の英字
        FolderSeq(1) = mySubMatches(0)

        ' ファイルの通番を表す四桁の数字が含まれる範囲
        ' 例．00AA0351 ⇒ "0300～0399"
        FolderSeq(2) = GetNumberRange(mySubMatches(1))

    Dim FolderPath As String
        FolderPath = Join(FolderSeq, "\")

' -------------↑↑ファイル名から保存パスを取得する。↑↑-------------

' -------------↓↓ファイル名の末尾にある履歴文字取得↓↓-------------

        myReg.Pattern = "(" & InitialFileName & ")([A-Z]?).pdf"

    Dim RevisionCol As Collection
    Set RevisionCol = New Collection

    Dim RevisonCharactor As String

    Dim myFile As File
        If FSO.FolderExists(FolderPath) = True Then
            For Each myFile In FSO.GetFolder(FolderPath).Files
                If myReg.test(myFile.Name) Then
                    Set MatchCase = myReg.Execute(myFile.Name)
                        RevisonCharactor = MatchCase(0).SubMatches(1)
                        If RevisonCharactor <> "" Then
                            RevisionCol.Add Asc(RevisonCharactor)
                        End If
                End If
            Next

' -------------↑↑ファイル名の末尾にある履歴文字取得↑↑-------------

' -------------↓↓最新版のファイル名を戻り値とする↓↓-------------

            Select Case RevisionCol.Count
                Case 0
                    GetFileRevision = file_name
                Case Else
                    Dim SQC As SequenceClass
                    Set SQC = New SequenceClass
                    RevisonCharactor = Chr(WorksheetFunction.Max(SQC.ToArray(RevisionCol)))
                    GetFileRevision = InitialFileName & RevisonCharactor
            End Select
        Else
            GetFileRevision = file_name
        End If

End Function

一昨日紹介した部分。実は、このために作成した。

Private Function GetNumberRange(val As Long) As String
    Dim Temp As Long
        Temp = WorksheetFunction.MRound(val, 100)
        If Temp > val Then
            Temp = Temp - 100
        End If
        GetNumberRange = Format(Temp, "0000") & _
                        "～" & _
                        Format(Temp + 99, "0000")
End Function

コレクションを配列に変換するために、たびたび登場するToArray関数（SeaquencClass）。今回も一応、記載しておく。

'［用　途］
'   コレクションを一次元配列に変換する
'［引　数］
'   col as Collection   元データ
'［戻り値］
'   一次元配列

Public Function ToArray(col As Collection) As Variant

    Dim seq As Variant
    ReDim seq(col.Count - 1)
    Dim c As Variant
    Dim i As Long
        i = 0
        For Each c In col
            seq(i) = c
            i = i + 1
        Next
    
    ToArray = seq

End Function

それでは、こちらで試してみる。ファイル名：AAB0001

Sub test()
    Dim RCC As RevisionCheckClass
    Set RCC = New RevisionCheckClass    
    MsgBox RCC.GetFileRevision("AAB0001")
End Sub

AAB0001に対し、最新版であるAAB0001Cを返してくれた。

さっそく、これに類するものを組み込んだツールを職場で配付した。今のところ、好評をいただいている。作ってよかった。

参考まで。