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：如何实现定时器来检查代码超时

回答

相关问题