Excel VBA：如何实现定时器来检查代码超时
我有一些运行在打开的工作簿上的代码，它使用表单来请求用户select共享目录映射到的驱动器。
这是因为工作簿使用VBA代码来检索并将数据保存到位于此共享目录中的共享工作簿，但本地驱动器由用户更改，因此他们需要select它。
我遇到的问题发生在用户已经将多个共享目录映射到他们的计算机上并因此具有多个驱动器时…例如：1个目录位于驱动器G：另一个位于X :.
如果他们select工作簿所在的共享目录的驱动器，则没有问题。 但是，如果他们不小心select其他共享目录的驱动器，代码挂起。
我有一个循环设置，检查，看看他们已经select了正确的驱动器… IE浏览器：如果他们selectA :(我的例子中不存在的驱动器），那么代码将注意到，他们select了不正确的驱动器和提示他们再次。
但是，如果select另一个共享目录，而不是创build错误，则代码将挂起。
在下面的代码中，表单1中的单元格AD3包含true或false（在sub的开始处设置为false）。 它被设置为true，如果他们已经select了正确的驱动器，因为Module6.PipelineRefresh不会再导致错误（该子试图打开共享驱动器中的工作簿…如果select的驱动器不正确，它显然会返回一个错误）
代码如下：
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 如果有人知道如何实现一个计时器，所以我可以在一段时间后closures代码，那会很好。
另外，如果你知道如何解决这个错误，那也太棒了！
编辑按照评论：
这是挂起的Module6.PipelineRefresh中的特定代码。 DriverSelectForm （如上所示）将单元格o1中的值修改为所选的驱动器string（即：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
注意：如上所述，如果用户select一个不存在的目录，上面的代码立即返回一个错误，因为它不能打开文件…如果他们有一个共享的目录映射到选定的驱动器（但它是错误的目录） ，代码将挂起并不会返回错误。
我通过解决这个问题来回答我自己的问题。 而不是检查用户select了正确的驱动器号，我现在使用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
定时器停止一些代码的解决scheme。 代码必须放在一个模块中。
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之类的事件处理程序作为被拒绝的程序。