我以不同的方式提出了這個問題，但這是在網路驅動器上的單個檔案夾中查找檔案的答案。
Sub GetFilesDetails()
Dim sh As Worksheet, lastR As Long, arrKeys, arrDate, i As Long, fileName As String
Dim folderPath As String, lastModifDate As Date, lastDate As Date
Const key2 As String = "Proof"
Set sh = ActiveSheet 'use here the necessary worksheet
lastR = sh.Range("B" & sh.rows.count).End(xlUp).Row
arrKeys = sh.Range("B4:B" & lastR).Value2 'place the range in an array for faster iteration
arrDate = sh.Range("G4:G" & lastR).Value2
folderPath = "C:/the necessary folder path" 'Use here your real Folder Path!!!
For i = 1 To UBound(arrKeys)
If arrKeys(i, 1) <> "" Then
fileName = Dir(folderPath & "\" & "*" & arrKeys(i, 1) & "*" & key2 & "*.xlsx")
lastDate = 0
Do While fileName <> ""
lastModifDate = CDate(Int(FileDateTime(folderPath & "\" & fileName)))
If lastModifDate > lastDate Then lastDate = lastModifDate
fileName = Dir
Loop
If lastModifDate <> 0 Then arrDate(i, 1) = lastModifDate: lastModifDate = 0
End If
Next i
With sh.Range("G4").Resize(UBound(arrDate), 1)
.Value2 = arrDate
.NumberFormat = "dd-mmm-yy"
End With
End Sub
我需要幫助才能在我的網路驅動器上的多個唯一檔案夾中查找多個檔案，并將修改的日期回傳到我的電子表格。
uj5u.com熱心網友回復：
請嘗試下一種方法。未經測驗，但我認為它應該可以作業。注意在“drivePath”主檔案夾中放置一個結束反斜杠（“”）。它假定要為特定的兩個鍵對處理的檔案應在以下模式的檔案夾中找到： main_folder\unknown_folder_Name" " & numeric_key & " "\PROOF" " & numeric_key & " " & AlphaNumeric_Key & " *.pdf"
Sub GetFilesDetailsAllFolders()
Const drivePath As String = "S:\", fileExt As String = "*.pdf"
Const key1 As String = "PROOF"
Dim sh As Worksheet, lastR As Long, arrKeys, arrDate, i As Long
Dim arrF, El, arrFold, strFold As String, boolFound As Boolean
Dim strGoodFold As String, sFoldCol As New Collection, LastD As Date
Set sh = ActiveSheet 'use here the necessary worksheet
lastR = sh.Range("B" & sh.rows.count).End(xlUp).Row
arrKeys = sh.Range("B4:B" & lastR).Value2 'place the range in an array for faster iteration
arrDate = sh.Range("G4:G" & lastR).Value2
arrF = AllFiles(drivePath, fileExt, True) 'build an array of all files having fileExt extension (from all folders and subfolders)!
For i = 1 To UBound(arrKeys)
If arrKeys(i, 1) <> "" Then
For Each El In arrF
If (strGoodFold <> "") And (left(El, InStrRev(El, "\")) <> strGoodFold) Then
strGoodFold = "": Exit For 'if iteration passed the appropriate (unique) subfolder...
End If
arrFold = Split(Replace(El, drivePath, ""), "\")
If UBound(arrFold) = 3 Then 'process only files full name having 3 subfolders (except drivePath):
If arrFold(1) Like "*" & arrKeys(i, 1) & "*" And _
arrFold(2) Like key1 And arrFold(3) Like _
"*" & arrKeys(i, 1) & "*" & key1 & fileExt Then
boolFound = True: strGoodFold = left(El, InStrRev(El, "\")) 'the path to exit the code if not the same folder
sFoldCol.Add El 'add the full name in the collection
End If
End If
Next El
If boolFound Then 'sFoldCol has been loaded with at least one file full path string
boolFound = False 'reitialize the boolean variable to cnnfirm collection loading
arrDate(i, 1) = LastModif(sFoldCol): Set sFoldCol = Nothing 'clear the collection
End If
End If
Next i
'drop the processec array content and format the range as Date:
With sh.Range("G4").Resize(UBound(arrDate), 1)
.Value2 = arrDate
.NumberFormat = "dd-mmm-yy"
End With
End Sub
它需要從主檔案夾的所有檔案夾和子檔案夾中回傳所有檔案全名的函式：
Private Function AllFiles(strFold As String, Optional strExt As String = "*.*", Optional boolSubfolders = False) As Variant
Dim arrFiles, i As Long, lastName As String, lngNb As Long, arrN, El
'return all files name in an array:
If boolSubfolders Then 'subfolders included:
arrFiles = filter(Split(CreateObject("wscript.shell").Exec("cmd /c dir """ & strFold & strExt & """ /b/s").StdOut.ReadAll, vbCrLf), "\")
Else 'without subfolders:
arrFiles = Split(CreateObject("wscript.shell").Exec("cmd /c dir """ & strFold & strExt & """ /b").StdOut.ReadAll, vbCrLf)
arrFiles = Split(strFold & Join(arrFiles, "|" & strFold), "|") 'add the folder path to the file names
arrFiles(UBound(arrFiles)) = "@@##": arrFiles = filter(arrFiles, "@@##", False) 'remove the last (empty) array element
End If
AllFiles = arrFiles
End Function
另一個回傳特定檔案的最后修改日期：
Function LastModif(col As Collection) As Date
Dim lastModifDate As Date, lastDate As Date, El
For Each El In col
lastModifDate = CDate(Int(FileDateTime(El)))
If lastModifDate > lastDate Then lastDate = lastModifDate
Next El
If lastModifDate <> 0 Then LastModif = lastModifDate
End Function
由于沒有測驗，我現在必須離開我的辦公室，它可能有問題。或者不...我確信它背后的邏輯是可以的，但是如果我遺漏了什么，請不要猶豫，解釋什么問題，什么錯誤以及在什么代碼行上。如果上述假設不正確，請說明哪個是基礎。
幾個小時后，當我在家時，我將能夠看到您的評論...
轉載請註明出處，本文鏈接：https://www.uj5u.com/shujuku/485423.html
上一篇：VBA沒有讀取陣列中的所有資料