假设文件名以 Long Number 开头，后跟“Suppl”，请尝试下一个代码。它将通过在arrFin 中添加“确定”返回所有文件确认的路径。 arrFin 的内容在 C:C 列中被删除，但可以在任何需要的地方删除：
Sub MatchFileExistence()
Dim sh As Worksheet, lastR As Long, arr, arrFin, i As Long
Const comPath As String = "C:\Documents\Files\"
Set sh = ActiveSheet
lastR = sh.Range("A" & sh.rows.count).End(xlUp).row 'last row in column A:A
arr = sh.Range("A2:B" & lastR).Value2
ReDim arrFin(1 To UBound(arr), 1 To 1) 'redim the array to keep the existence confirmation
For i = 1 To UBound(arr)
If Dir(comPath & arr(i, 2) & "\" & arr(i, 1) & " Supp*.pdf") <> "" Then
arrFin(i, 1) = "OK" 'use here what confirmation string you need...
End If
Next i
'drop the processed array result:
sh.Range("C2").Resize(UBound(arrFin), 1).Value2 = arrFin
End Sub
请在测试后发送一些反馈。
已编辑：
请测试下一个版本。它将检查 arrFolders 数组中所有文件夹中 A:A 列中的所有长数字，并返回找到该文件的子文件夹。如果在很多地方找到它，它将返回以“|”分隔的位置：
Sub MatchFileExistence()
Dim sh As Worksheet, lastR As Long, arr, arrFin, El, arrFolders, i As Long
Const comPath As String = "C:\Teste VBA Excel\Folders\" '"C:\Documents\Files\"
arrFolders = Split("NBI,Authorized,Awaiting Check,Rejected", ",") 'place subfolders in a list
Set sh = ActiveSheet
lastR = sh.Range("A" & sh.rows.count).End(xlUp).row 'last row in column A:A
'in case of placing the necessary folders in column B:B, please uncomment the next line
'arrFolders = sh.Range("B2", sh.Range("B" & sh.rows.count).End(xlUp)).Value2
arr = sh.Range("A2:A" & lastR).Value2
ReDim arrFin(1 To UBound(arr), 1 To 1) 'redim the array to keep the existence confirmation
For Each El In arrFolders
For i = 1 To UBound(arr)
If Dir(comPath & El & "\" & arr(i, 1) & " *.pdf") <> "" Then
If arrFin(i, 1) = "" Then
arrFin(i, 1) = El
Else
arrFin(i, 1) = arrFin(i, 1) & "|" & El
End If
End If
Next i
Next El
'drop the processed array result:
sh.Range("C2").Resize(UBound(arrFin), 1).Value2 = arrFin
End Sub
它将处理结果从第二行开始放在同一 C:C 列中。
如果您打算将文件夹放在一个范围内（在一列上，让我们说 B:B），请取消注释行 'arrFolders = sh.Range("B2", sh.Range("B" & sh.rows.count).End(xlUp)).Value2... 如果不是 B:B，请更新代码以匹配实际使用的列。
已编辑：
请测试下一个版本。它将首先返回根文件夹及其所有子文件夹的出现数组，然后将评估该数组以提取文件夹：
Sub MatchFileExistenceX()
Dim sh As Worksheet, lastR As Long, arr, arrFin, i As Long, arrFiles, El, arrFld
Const comPath As String = "C:\Documents\Files\"
Set sh = ActiveSheet
lastR = sh.Range("A" & sh.rows.count).End(xlUp).row 'last row in column A:A
arr = sh.Range("A2:B" & lastR).Value2
ReDim arrFin(1 To UBound(arr), 1 To 1) 'redim the array to keep the existence confirmation
For i = 1 To UBound(arr)
If Not IsError(arr(i, 1)) Then
arrFiles = getAllFls(comPath, arr(i, 1) & " *.pdf")
If UBound(arrFiles) > -1 Then
For Each El In arrFiles
arrFld = Split(El, "\")
If arrFin(i, 1) = "" Then
arrFin(i, 1) = arrFld(UBound(arrFld) - 1)
Else
arrFin(i, 1) = arrFin(i, 1) & "|" & arrFld(UBound(arrFld) - 1)
End If
Next El
End If
End if
Next i
'drop the processed array result:
sh.Range("C2").Resize(UBound(arrFin), 1).Value2 = arrFin
End Sub
Private Function getAllFls(strFold As String, Optional strExt As String = "*.*") As Variant
getAllFls = filter(Split(CreateObject("wscript.shell").exec("cmd /c dir """ & strFold & strExt & """ /b/s").StdOut.ReadAll, vbCrLf), "\")
End Function
请使用 comPath 作为包含所有其他子文件夹的根文件夹...
现在我要离开我的办公室了。如果有不清楚的地方，请要求澄清，但我会在家时回答。