1

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

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

当用户将多个共享目录映射到他们的计算机并因此具有多个驱动器时，我遇到的问题会发生...例如：1 个目录位于驱动器 G: 上，另一个位于 X: 上。

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

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

但是，代码不是在选择另一个共享目录时创建错误，而是悬挂。

在下面的代码中，第一页上的单元格 AD3 包含 true 或 false（在 sub 的开头设置为 false）。如果他们选择了正确的驱动器作为 Module6，它将设置为 true。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这是挂起的特定代码。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

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

4

2 回答 2

2

我已经通过解决这个问题回答了我自己的问题。我现在不是检查用户是否选择了正确的驱动器号，而是使用该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-13T14:00:50.960 回答
1

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

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-29T11:03:14.040 回答