我有一个包含数千个文件的文件夹，以及一个包含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
答案 0 :(得分：1)
如果没有看到您的数据集，很难说，但也许可以实施这种方法（请注意使用Wildcards）：
<强> UNTESTED
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类型的匹配项，它就会将文件名连接在一起。
See this great SO post关于循环文件。
See this site了解有关Dir功能的更多信息
关于字符串比较时使用wilcard字符的See this article。
希望有所帮助！
答案 1 :(得分：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