Question

我有一些在打开的工作簿上运行的代码，它使用一个表单来请求用户选择共享目录映射到的驱动器。

这是因为工作簿使用VBA代码检索数据并将数据保存到位于此共享目录中的共享工作簿，但本地驱动器会由用户更改，因此需要选择它。

我遇到的问题发生在用户将多个共享目录映射到他们的计算机并因此具有多个驱动器时...例如：1个目录在驱动器G上：另一个在X上：./ / p >

如果他们选择工作簿所在的共享目录的驱动器，则没有问题。但是，如果他们意外地为其他共享目录选择了驱动器，则代码会挂起。

我有一个循环设置，检查他们是否选择了正确的驱动器... IE：如果他们选择A :(在我的示例中不存在的驱动器），那么代码会注意到他们选择了错误的开车并再次提示他们。

但是，当选择另一个共享目录时，代码只会挂起而不是创建错误。

在下面的代码中，第一张单元格AD3包含true或false（在sub的开头设置为false）。如果他们选择了正确的驱动器作为Module6.PipelineRefresh将不再导致错误（此子尝试在共享驱动器中打开工作簿...如果所选驱动器不正确，它显然会返回错误），则设置为true

代码如下：

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中的特定代码。 DriverSelectForm（如上所示）将单元格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

注意：如上所述，如果用户选择一个不存在的目录，上面的代码会立即返回错误，因为它无法打开文件...如果他们有一个映射到所选驱动器的共享目录（但它是错误的目录），代码将挂起并且似乎不会返回错误。

Answer 1

我通过解决这个问题回答了我自己的问题。我现在使用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

Answer 2

通过计时器停止某些代码的解决方案。代码必须放在模块中。

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）称为延迟过程。

Excel VBA：如何实现计时器以检查代码超时

2 个答案: