函数单独工作但不能一起工作,返回0值

时间:2016-08-31 23:16:41

标签: excel vba function

我最近在这里获得了第一个函数的帮助,但我很难理解为什么我的代码无效...

我试图使用ReportTimeByOP函数查找位于" sFolder"中的最新文件。以" sName"开头这有一个" sOPID"匹配"值38" ReadTextFile函数的结果。

无论出于何种原因,我都可以让两个函数独立工作,但我尝试将它们组合成一个无缝操作失败了。我现在拥有的是:

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

1 个答案:

答案 0 :(得分:2)

鉴于文件数量巨大,我完全跳过了Dir功能。我也跳过了按创建日期对结果进行人工分类的方法(我假设这是标准 - 如果没有,它应该很容易修改)。让Windows Shell为您做繁重的工作。与VBA Dir()函数或Scripting.FileSystemObject不同,shell dir命令有大量参数,允许您检索已排序的输出。为此,浏览按相反顺序排序的文件列表要高效得多。 You can see all of the dir options here

所以,我通过shelling到dir命令来解决这个问题,该命令以反向日期顺序检索文件列表,将其传递给临时文件,然后选择要通过的临时文件列表。这样你就可以在找到第一场比赛时退出。然后,您可以使用ReadTextFile

简化循环和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

这个宣言在某处:

Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
相关问题