Mblankfield
Mblankfield

Reputation: 23

Functions work separately but not together, returns 0 value

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

Answers (1)

Comintern
Comintern

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

Related Questions