如何當VBA函數花費的時間比時間的長短來計算

Question

我在我的VBA代碼中的功能，這將下載從FTP，我有時候打電話，像這樣

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

由於連接的文件拋出一個錯誤問題等這個功能掛起和不響應。我想顯示一個錯誤信息，如果這個函數超過5秒不設置成功=真，並取消整個子執行。

我試圖亂搞具有以下只是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

你應該控制你的.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 

Answer 2

只需設置.RequestTimeoutproperty：

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