当VBA函数的计算时间超过长度时如何抛出错误

Question

我的VBA代码中有一个从FTP下载文件的函数，我这样调用它

success = fnDownloadFile(hostName, UserName, Password, _
        remoteFileStr, _
        desktopPath & "downloaded.csv")

有时由于连接问题等原因，此函数挂起且不响应。如果此函数花费超过5秒的时间没有设置success = True并取消整个sub的执行，我会显示一条错误消息。

我试着在ftp函数调用之前修改以下代码，但是我不能让它工作：

Application.OnTime Now + TimeValue("00:00:05"), "checkIfSuccessIsFalseAndStop"

函数代码如下：

Function fnDownloadFile(ByVal strHostName As String, _
    ByVal strUserName As String, _
    ByVal strPassWord As String, _
    ByVal strRemoteFileName As String, _
    ByVal strLocalFileName As String) As Boolean

    '// Set a reference to: Microsoft Internet Transfer Control
    '// This is the Msinet.ocx
    Debug.Print "Value for file passed as:" & strRemoteFileName

    Dim FTP As Inet    'As InetCtlsObjects.Inet

    Set FTP = New Inet 'InetCtlsObjects.Inet

    On Error GoTo Errh
    With FTP
        .URL = strHostName
        .Protocol = 2
        .UserName = strUserName
        .Password = strPassWord
        .Execute , "Get " + strRemoteFileName + " " + strLocalFileName
        Do While .StillExecuting
            DoEvents
        Loop
        'fnDownloadFile = .ResponseInfo
    End With
Xit:
    Set FTP = Nothing
    Exit Function

    fnDownloadFile = True
        Debug.Print "Download completed"
Errh:
    'fnDownloadFile = "Error:-" & Err.Description
    fnDownloadFile = False
    Resume Xit
End Function

Answer 1

只需设置.RequestTimeout property

With FTP
    .URL = strHostName
    .Protocol = 2
    .UserName = strUserName
    .Password = strPassWord
    .RequestTimeout 5       '<------
    .Execute , "Get " + strRemoteFileName + " " + strLocalFileName

Answer 2

您应该在.StillExecuting循环中控制这一点

我想这应该行得通。这在很大程度上取决于您的inet类是什么:自定义引用还是MSINET.OCX引用。如果它是自定义的，那么您应该声明cancel方法。

Dim dtStart As Date
dtStart = Now
.Execute , "Get " + strRemoteFileName + " " + strLocalFileName
Do While .StillExecuting

    If DateDiff("s", Now, dtStart) > 5 Then
        ' Cancel after5 seconds
        .Cancel
        .Execute , "CLOSE" ' Close the connection
        MsgBox "Download cancelled after 5 seconds"
    End If

    DoEvents
Loop