Excel VBA：如何實現定時器來檢查代碼超時

我有一些代碼運行在打開的工作簿上，使用表單來請求用戶選擇共享目錄映射到的驅動器。Excel VBA：如何實現定時器來檢查代碼超時

這是因爲工作簿使用VBA代碼檢索並將數據保存到位於此共享目錄中的共享工作簿，但本地驅動器由用戶更改，因此他們需要選擇它。

我遇到的問題發生在用戶將多個共享目錄映射到他們的計算機上並因此具有多個驅動器時......例如：1個目錄位於驅動器G上：另一個位於X：上。

如果他們選擇工作簿所在的共享目錄的驅動器，則沒有問題。但是，如果他們不小心選擇其他共享目錄的驅動器，則代碼會掛起。我有一個循環設置，檢查他們選擇了正確的驅動器... IE：如果他們選擇A :(我的例子中不存在的驅動器），那麼代碼會注意到他們選擇了不正確的驅動器並再次提示。

但是，當選擇另一個共享目錄時，不會產生錯誤，代碼只會掛起。

在下面的代碼中，表1中的單元格AD3包含true或false（在sub的開始處設置爲false）。如果他們選擇了正確的驅動器，它將被設置爲true，因爲Module6.PipelineRefresh不會再導致錯誤（此子試圖打開共享驅動器中的工作簿...並且如果選擇的驅動器不正確，它顯然會返回錯誤）

代碼是如下：

Do While Sheet1.Range("ad3") = False 
    On Error Resume Next 
     Call Module6.PipelineRefresh '~~ I'm guessing the code hangs here. Instead of returning an error immediately, as it would if they simply chose a non-existant drive, it appears to get stuck trying to open the workbook, even though it's not located in the shared directory they've selected. 
    If Err.Number = 0 Then 
     Sheet1.Range("ad3") = True 
     Err.Clear 
    Else 
     MsgBox "Invalid Network Drive." 
     DriverSelectForm.Show 
     Err.Clear 
    End If 
Loop

如果有人知道如何實現一個計時器，所以我可以關機一定時間後的代碼，那簡直太好了。

另外，如果你知道如何解決這個錯誤，那也會很棒！

編輯按評論：

這是Module6.PipelineRefresh是掛在特定的代碼。所述（如上所示）在細胞O1的值修正到所選擇的驅動器的字符串（即：X :)

Dim xlo As New Excel.Application 
Dim xlw As New Excel.Workbook 
Dim xlz As String 
xlz = Sheet1.Range("o1").Value & "\Region Planning\Created Pipeline.xlsx" 
Dim WS As Worksheet 
Dim PT As PivotTable 

Application.DisplayAlerts = False 
Set xlw = xlo.Workbooks.Open(xlz) 
Application.DisplayAlerts = True

注：如上所述，如果用戶選擇一個不存在的目錄中，上述代碼返回立即出現錯誤，因爲它無法打開文件...如果它們具有映射到所選驅動器的共享目錄（但它是錯誤的目錄），則代碼將掛起並且不會返回錯誤。

來源

2013-05-13 Sam WB

當選擇錯誤的驅動器時，實際掛起的代碼是什麼？除了沒有預期的目錄是其他驅動器常規網絡共享？還是他們映射到一個VPN，他們需要登錄？ – 2013-05-13 10:36:22

是'DriverSelectForm'打開標準文件對話框，還是一些自定義導航？ – 2013-05-13 12:25:05

將在一條評論中回答兩個問題：共享目錄驅動器映射到一個vpn（並且需要在這個意義上的登錄）。我將編輯該問題以包含暫時掛起的特定代碼。 'DriverSelectForm'是一個自定義導航，只是允許他們選擇一個字母（例如：'X：'），然後將其添加到用於打開工作簿的文件路徑中。 – 2013-05-13 12:46:31

我已經通過解決問題來解答我自己的問題。而不是檢查用戶選擇了正確的驅動器號，我現在使用CreatObject函數查找與驅動器名稱關聯的驅動器號（因爲驅動器名稱不會更改）。

用於本實施例的代碼：

Dim objDrv  As Object 
Dim DriveLtr  As String 

For Each objDrv In CreateObject("Scripting.FileSystemObject").Drives 
    If objDrv.ShareName = "Shared Drive Name" Then 
     DriveLtr = objDrv.DriveLetter 
    End If 
Next 

If Not DriveLtr = "" Then 
    MsgBox DriveLtr & ":" 
Else 
    MsgBox "Not Found" 
End If 
Set objDrv = Nothing

來源

2013-05-13 14:00:50

我還會試圖在比較時同時使用$（） – 2013-05-13 15:41:39

將溶液通過計時器停止一些代碼。代碼必須放在模塊中。

Private m_stop As Boolean 
Sub stop_timer(p_start_time As Variant) 
    Application.OnTime p_start_time, "stop_loop" 
End Sub 
Sub signal_timer(p_start_time As Variant) 
    Application.OnTime p_start_time, "signal_in_loop" 
End Sub 
Sub test_loop() 
    Dim v_cntr As Long 
    m_stop = False 
    v_cntr = 0 
    stop_timer Now + TimeValue("00:00:05") 
    signal_in_loop 
    While Not m_stop 
    v_cntr = v_cntr + 1 
    DoEvents 
    Wend 
    Debug.Print "Counter:", v_cntr 
End Sub 
Sub stop_loop() 
    m_stop = True 
End Sub 
Sub signal_in_loop() 
    Debug.Print "timer:", Timer 
    If Not m_stop Then 
    signal_timer Now + TimeValue("00:00:01") 
    End If 
End Sub

輸出：

timer:   50191.92 
timer:   50192 
timer:   50193 
timer:   50194 
timer:   50195 
timer:   50196 
Counter:  67062 
timer:   50197.05

M_STOP控制循環。 DoEvents調用諸如stop_loop和signal_in_loop之類的事件處理程序作爲被拒絕的過程。

來源

2014-10-29 11:03:14

Excel VBA：如何實現定時器來檢查代碼超時

回答

相關問題