I have some code that runs on workbook open that uses a form to request that the user select the drive to which a shared directory is mapped.
This is because the workbook uses VBA code to retrieve and save data to a shared workbook located in this shared directory, but the local drive changes by user, so they need to select it.
The problem I’ve run into occurs when the user has mapped multiple shared directories to their computer and thus have multiple drives… ex: 1 directory is on drive G: and the other is on X:.
If they select the drive for the shared directory in which the workbook resides, there is no problem. However, if they accidentally choose the drive for the other shared directory, the code hangs.
I have a loop setup that checks to see they’ve chosen the correct drive… IE: If they chose A: (a non-existent drive in my example), then the code will note that they chose the incorrect drive and prompt them again.
However, instead of creating an error when another shared directory is chosen, the code just hangs.
In the below code, cell AD3 on sheet one contains true or false (gets set to false in the beginning of the sub). It gets set to true if they’ve chosen correct drive as Module6.PipelineRefresh will no longer cause an error (this sub attempts to open the workbook in the shared drive… and if the chosen drive is incorrect it obviously returns an error)
Codes is as below:
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
If anyone knows how to implement a timer so I can shutdown the code after some amount of time, that’d be great.
Alternatively, if you know how to get around this error, that’d also be great!
EDIT as per comment:
This is the specific code in
Module6.PipelineRefresh that hangs. The
DriverSelectForm (shown above) amends the value in cell o1 to the chosen drive string (ie: 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
Note: As stated above, if the user selects a non-existent directory, the above code returns an error immediately because it cannot open the file… if they have a shared directory mapped to the chosen drive (but it’s the wrong directory), the code will hang and does not appear to return an error.
I’ve answered my own question by working around the problem. Instead of checking that the user has selected the correct drive letter, I am now using the
CreatObject function to find the drive letter associated with the drive name (as drive name will not change).
Example code for this:
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
The solution to stop some code by timer. The code must be placed in a module.
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 controls the loop. DoEvents calls event handlers such as stop_loop and signal_in_loop as defered procedures.