1

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
Cœur
  • 32,421
  • 21
  • 173
  • 232
  • 1
    "code is not working" is not helpful to anyone. Please provide details of what the expected behavior is, and what the error is. – DeanOC Aug 31 '16 at 23:20
  • 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 is the expected behavior. Returns 0 value is the current error. I assume it is not passing a variable between the if statements correctly but I am not sure. – Mblankfield Aug 31 '16 at 23:23
  • The output should be a date. It should be the most recent date that matches all three criteria. – Mblankfield Aug 31 '16 at 23:30
  • Why on earth would you use a mix of `FileSystemObject` and legacy VBA file handling? If you iterate the actual `File` objects in the directory instead of using `Dir`, you can use the FSO methods to read the file... – Comintern Aug 31 '16 at 23:30
  • Need to do a little debugging - add some `Debug.Print` lines or breakpoints to make sure you're getting the values you expect – Tim Williams Aug 31 '16 at 23:30
  • @Comintern I initially tried with FileSystemObject but the folder has ~13,000 files and is growing daily. – Mblankfield Aug 31 '16 at 23:32
  • @Mblankfield maybe this can help http://spreadsheetpage.com/index.php/tip/identifying_the_newest_file_in_a_directory/ – Slai Aug 31 '16 at 23:34
  • Am I missing something? What is `Split(fline, vbTab)(38)`? – Jim Hewitt Aug 31 '16 at 23:39
  • @JimHewitt that gets the 38th value on the second line of a tab delimited file – Slai Aug 31 '16 at 23:45
  • @Jim Slai is correct. I want to compare the 38th value on the second line of my tab delimited file to the input value of sOPID and make sure they are equal. – Mblankfield Aug 31 '16 at 23:49
  • Is `MsgBox fpath` firing? – Comintern Aug 31 '16 at 23:51
  • Also - what does `FileDateTime` return? The file creation date? – Comintern Aug 31 '16 at 23:56
  • @Comintern No, I can only get it to fire by running just the first function. FileDateTime returns either creation date or last modified date but in my case they are always going to be the same. – Mblankfield Aug 31 '16 at 23:56
  • using (38) will give you the 39th element in the line, since Split by default creates a zero-based array. – Tim Williams Sep 01 '16 at 05:37

1 Answers1

2

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)
Comintern
  • 20,878
  • 5
  • 30
  • 73
  • Wow! Thank you so much. It works great. I really appreciate you finding a better way to solve my problem. This made my day :D – Mblankfield Sep 01 '16 at 01:45
  • @Mblankfield - I felt your pain when you said 13K files and growing daily... ;-) – Comintern Sep 01 '16 at 01:50
  • @Mblankfield - Also forgot to mention. If you start getting weird FSO errors like "File not found" or "Read past end of stream" on the temp file, either increase the 'Sleep' time or switch to something like [Chip Pearson's ShellAndWait implementation](http://www.cpearson.com/excel/ShellAndWait.aspx). – Comintern Sep 01 '16 at 01:54
  • a bit easier with Wscript.Shell http://stackoverflow.com/a/32600510/1383168 – Slai Sep 01 '16 at 02:51