0

我有一个包含数千个文件的文件夹，以及一个包含 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
4

2 回答 2

1

没有看到你的数据集就很难判断，但也许可以实现这种方法（注意使用Wildcards）：

未经测试

Const Folder As String = "C:\YourFolder\"  
Dim File as Object
Dim XLSFile As String
Dim PDFFile As String
Dim ConCat() As String
Dim DocNos() As Variant
Dim DocRev() As Variant
Dim i As Long

DocNos = Range("A1:A10") '<--Your list of Document #s.
DocRev = Range("B1:B10") '<--Your list of Revision #s.
ReDim ConCat(1 To UBound(DocNos))

'Loop through your Document numbers.
For i = LBound(DocNos) To UBound(DocNos)
    'Loop through the folder.
    File = Dir(Folder)
    Do While File <> ""
        'Check the filename against the Document number. Use a wildcard at this _
        'point as a sort of "gatekeeper"
        If File Like Left(DocNos(i), Len(DocNos(i)) - 3) & "*"
            'If the code makes it to this point, you just need to match file _
            'type and revision.
            If File Like "*_*" & DocRev(i) And File Like "*.xls*" Then
                XLSFile = File
            ElseIf File Like "*_*" & DocRev(i) File Like "*.pdf" Then
                PDFFile = File
            End If
            If XLSFile <> "" And PDFFile <> "" Then 
                ConCat(i) = XLSFile & "|" & PDFFile
                XLSFile = vbNullString
                PDFFile = vbNullString
            End If
        End If
        File = Dir
    Loop
Next i

要将结果打印到您的工作表（Transpose将数组的结果粘贴在一列中，而不是将结果放在一行中），您可以使用以下内容：

Dim Rng As Range

Set Rng = Range("C1")
Rng.Resize(UBound(ConCat),1).Value = Application.Transpose(ConCat)

这种方法循环遍历电子表格中的每个文档编号，然后检查文件夹中的每个文件以查看它是否与文档编号、文档类型和修订号匹配。一旦找到 .xls* 和 .pdf 类型的匹配项，它就会将文件名连接在一起。

请参阅有关循环文件的这篇很棒的 SO 帖子。有关该功能的更多信息，
请参阅此站点Dir。在比较字符串时，
请参阅这篇关于通配符使用的文章。

希望有帮助！

于 2013-11-06T04:31:10.083 回答
0

在我看来，即使在已经找到文件的情况下，您也在进行不必要的文件存在检查。假设与您的网络驱动器交谈确实占用了您大部分的执行时间，那么就有一个地方可以优化。

你在做什么是这样的：

If IsFileReadOnlyOpen(sMasterPath & sLegacyDocNum & sRevisionSpacer(i) & sRevision & sFileExtensions(j)) <> 2 Then
    'Great. Found it.
    '...
End If
'Do it again without a sheet number in the filename (last 3 digits stripped off legacy number)
'Wait a minute... why ask me to look again if I already found it?
'He must not mind the extra waiting time... ok, here we go again.
If IsFileReadOnlyOpen(sMasterPath & sLegacyDocNumNoSheet & sRevisionSpacer(i) & sRevision & sFileExtensions(j)) <> 2 Then
    '...
End If

我认为当且仅当您没有在第一个文件名模式下找到它时，您才想以不同的文件名查找文件。可以使用Else子句做到这一点：

If IsFileReadOnlyOpen(sMasterPath & sLegacyDocNum & sRevisionSpacer(i) & sRevision & sFileExtensions(j)) <> 2 Then
    'Great. Found it.
Else
    'Didn't find it using the first filename format.
    '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
        'Great. Found it.
    Else
        Err.Raise 53, , _
            "File not found even though I looked for it in two places!"
    End If
End If

从理论上讲，这可以将您的尝试次数减少一半；在实践中可能更少，但如果您首先检查最常见的文件名模式，您将获得最大的好处。如果您有更多的文件名模式，好处将成比例地增加；根据您的问题，我了解您有 4 种不同的组合？

如果要检查的模式超过 2 个，那么嵌套一堆Else子句会看起来很傻，而且难以阅读；相反，您可以执行以下操作：

Dim foundIt As Boolean
foundIt = False
If Not foundIt And IsFileReadOnlyOpen(sMasterPath & sLegacyDocNum & sRevisionSpacer(i) & sRevision & sFileExtensions(j)) <> 2 Then
    'Great. Found it.
    foundIt = True
End If
If Not foundIt And IsFileReadOnlyOpen(sMasterPath & sLegacyDocNumNoSheet & sRevisionSpacer(i) & sRevision & sFileExtensions(j)) <> 2 Then
        'Great. Found it.
        foundIt = True
End If
'...
'... check your other patterns here...
'...
If Not foundIt Then
    Err.Raise 53, , _
        "File not found even though I looked for it various places!"
End If
于 2013-11-06T08:20:52.923 回答