Reputation: 23
I recently got help here with the first function but I am stumped about why my code is not working..
I'm trying to use the ReportTimeByOP function to find the newest file located in "sFolder" that begins with "sName" and that has a "sOPID" that matches the "value38" result of the ReadTextFile function.
For whatever reason I have no trouble getting both functions to work independently but my attempts to combine them into one seamless operation have failed. What I currently have is:
Function ReadTextFile(fpath)
Dim fline As String
Dim fnumb As Long
Dim i As Long
Dim Wanted As String
fnumb = FreeFile
Open fpath For Input As #fnumb
i = 1
Do While Not EOF(fnumb)
Line Input #fnumb, fline
If i = 2 Then
Wanted = Split(fline, vbTab)(38)
Exit Do
End If
i = i + 1
Loop
Close #fnumb
MsgBox fpath
ReadTextFile = Wanted
End Function
Function ReportTimeByOP(ByVal sName As String, ByVal sFolder As String, ByVal sOPID As String)
Dim FileName As String
Dim MostRecentFile As String
Dim MostRecentDate As Date
Dim value38 As String
Dim oFSO As FileSystemObject
If Right(sFolder, 1) <> "\" Then sFolder = sFolder & "\"
Set oFSO = CreateObject("Scripting.FileSystemObject")
If oFSO.FolderExists(sFolder) Then
FileName = Dir(sFolder & sName & "*hdr.txt", 0)
If FileName <> "" Then
MostRecentFile = FileName
MostRecentDate = FileDateTime(sFolder & FileName)
Do While FileName <> ""
value38 = ReadTextFile(sFolder & FileName)
If FileDateTime(sFolder & FileName) > MostRecentDate And Trim(value38) = Trim(sOPID) Then
MostRecentFile = FileName
MostRecentDate = FileDateTime(sFolder & FileName)
value38 = ReadTextFile(sFolder & FileName)
End If
FileName = Dir
DoEvents
Loop
End If
Else
MostRecentFile = "Err: folder not found."
End If
Set oFSO = Nothing
ReportTimeByOP = MostRecentDate
End Function
Upvotes: 1
Views: 89
Reputation: 22205
Given the huge number of files, I'd skip the Dir
function entirely. I'd also skip the manual sorting of the results by creation date (I'm assuming this is the criteria - if not, it should be fairly easy to modify). Let the Windows Shell do the heavy lift for you. Unlike the VBA Dir()
function or the Scripting.FileSystemObject
, the shell dir
command has a ton of parameters that allow you to retrieve sorted output. For this purpose, going through a list of files sorted in reverse order is much, much more efficient. You can see all of the dir
options here.
So, I'd approach this by shelling to a dir
command that retrieves the list of files in reverse date order, pipe it to a temp file, and then pick up the temp file to go through the list. That way you can just exit when you find your first match. Then you can simplify both your loop and ReadTextFile
function by using the FileSystemObject
:
ReadTextFile:
Public Function ReadTextFile(target As File) As String
With target.OpenAsTextStream
If Not .AtEndOfStream Then .SkipLine
Dim values() As String
If Not .AtEndOfStream Then
values = Split(.ReadLine, vbTab)
If UBound(values) >= 38 Then
ReadTextFile = values(38)
End If
End If
.Close
End With
End Function
ReportTimeByOP:
Function ReportTimeByOP(ByVal sName As String, ByVal sFolder As String, _
ByVal sOPID As String) As Date
With New Scripting.FileSystemObject
Dim temp As String
temp = .BuildPath(.GetSpecialFolder(TemporaryFolder), .GetTempName)
Dim seeking As String
seeking = .BuildPath(sFolder, sName & "*hdr.txt")
Shell "cmd /c dir """ & seeking & """ /b /a:-d /o:-d > " & temp
'Shell is asychronous - wait .2 seconds for it to complete.
Sleep 200
With .GetFile(temp).OpenAsTextStream
Dim directory() As String
directory = Split(.ReadAll, vbNewLine)
.Close
End With
.DeleteFile temp
Dim i As Long
Dim value38 As String
Dim candidate As File
'Temp file will end with a newline, so the last element is empty.
For i = LBound(directory) To UBound(directory) - 1
Set candidate = .GetFile(.BuildPath(sFolder, directory(i)))
value38 = ReadTextFile(candidate)
If Trim$(value38) = Trim$(sOPID) Then
ReportTimeByOP = candidate.DateCreated
Exit Function
End If
Next i
End With
End Function
And this declaration somewhere:
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Upvotes: 2