vba - Excel VBAを使用してファイルが存在するかどうかを確認するより良い方法はありますか

Question

何千ものファイルを含むフォルダーと、次の 2 つの情報を含むスプレッドシートがあります。

DocumentNumber       Revision
00-STD-GE-1234-56       3

このドキュメント番号とリビジョンの組み合わせを次の形式に一致させるには、フォルダー内のすべてのファイルを検索して連結する必要があります。

00-STD-GE-1234-56_3.docx|00-STD-GE-1234-56_3.pdf

pdf は最後でなければならない 場合によっては、ドキュメント番号の最後の 3 文字なしでファイルの名前が付けられる場合があります (それらが -00 の場合は省略されます) 場合によってはリビジョンが「_」を使用して、場合によっては「_r」を使用して区切られます

コードは機能していますが、時間がかかります (このシートには 7000 行以上あり、このコードはネットワーク ファイル システムに対して行ごとに 20 個のファイルを比較しています)。これを最適化する方法はありますか?

''=============================================================================
 Enum IsFileOpenStatus
        ExistsAndClosedOrReadOnly = 0
        ExistsAndOpenSoBlocked = 1
        NotExists = 2
End Enum
''=============================================================================

Function IsFileReadOnlyOpen(FileName As String) As IsFileOpenStatus

'ExistsAndClosedOrReadOnly = 0
'ExistsAndOpenSoBlocked = 1
'NotExists = 2

With New FileSystemObject
        If Not .FileExists(FileName) Then
                    IsFileReadOnlyOpen = 2  '  NotExists = 2
                    Exit Function 'Or not - I don't know if you want to create the file or exit in that case.
        End If
End With

Dim iFilenum As Long
Dim iErr As Long
        On Error Resume Next
                    iFilenum = FreeFile()
                    Open FileName For Input Lock Read As #iFilenum
                    Close iFilenum
                    iErr = Err
        On Error GoTo 0

Select Case iErr
    Case 0: IsFileReadOnlyOpen = 0 'ExistsAndClosedOrReadOnly = 0
    Case 70: IsFileReadOnlyOpen = 1 'ExistsAndOpenSoBlocked = 1
    Case Else: IsFileReadOnlyOpen = 1 'Error iErr
End Select

End Function    'IsFileReadOnlyOpen
''=============================================================================

Function BuildAndCheckPath(sMasterPath As String, sLegacyDocNum As String, sRevision As String) As String
Dim sLegacyDocNumNoSheet As String
sLegacyDocNumNoSheet = Left(sLegacyDocNum, Len(sLegacyDocNum) - 3)
Dim sFileExtensions
sFileExtensions = Array(".doc", ".docx", ".xls", ".xlsx", ".pdf")
Dim sRevisionSpacer
sRevisionSpacer = Array("_", "_r")
Dim i As Long
Dim j As Long
Dim sResult As String

'for each revision spacer option
For i = LBound(sRevisionSpacer) To UBound(sRevisionSpacer)
'for each file extension
For j = LBound(sFileExtensions) To UBound(sFileExtensions)
    'Check if the file exists (assume a sheet number i.e. 00-STD-GE-1234-56)
    If IsFileReadOnlyOpen(sMasterPath & sLegacyDocNum & sRevisionSpacer(i) & sRevision & sFileExtensions(j)) <> 2 Then
        If sResult = "" Then
            sResult = sLegacyDocNum & sRevisionSpacer(i) & sRevision & sFileExtensions(j)
        Else
            sResult = sResult & "|" & sLegacyDocNum & sRevisionSpacer(i) & sRevision & sFileExtensions(j)
        End If
    End If
    'Do it again without a sheet number in the filename (last 3 digits stripped off legacy number)
    If IsFileReadOnlyOpen(sMasterPath & sLegacyDocNumNoSheet & sRevisionSpacer(i) & sRevision & sFileExtensions(j)) <> 2 Then
        If sResult = "" Then
            sResult = sLegacyDocNumNoSheet & sRevisionSpacer(i) & sRevision & sFileExtensions(j)
        Else
            sResult = sResult & "|" & sLegacyDocNumNoSheet & sRevisionSpacer(i) & sRevision & sFileExtensions(j)
        End If
    End If
Next j
Next i

BuildAndCheckPath = sResult

End Function