jenlain
asked on
Execute DOS command in VB and wait for the end of the execution
I want to execute the following DOS command in VB6 to map a drive :
"net use m: \\myserver\mydrive ..."
BUT, I want my program do a pause to the end of the execution of this command.
If i use :
shell("net use m: \\myserver\mydrive ...")
It's not working cause the program don't wait for the end of the command and after this I have a code witch need to have the M drive mapped...
Thanks for your help !!
"net use m: \\myserver\mydrive ..."
BUT, I want my program do a pause to the end of the execution of this command.
If i use :
shell("net use m: \\myserver\mydrive ...")
It's not working cause the program don't wait for the end of the command and after this I have a code witch need to have the M drive mapped...
Thanks for your help !!
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
p_sie
Use the ShellExecute API
Rather than wait for the application to finish, why not wait until the drive becomes accessible? This way, you know that when the rest of your code is executed, the drive will definatly be existant. If, for whatever reason, the DOS command fails to map the drive and your code continues to run, your gonna get problems and errors kicking up.
Place this in a module:
'### START OF MODULE ###
Option Explicit
Public Enum DRIVE_STATUS
DRIVE_DOESNT_EXIST = 1
DRIVE_NOT_READY = 2
DRIVE_READY = 3
End Enum
Private Declare Function GetDiskFreeSpace Lib "kernel32" Alias "GetDiskFreeSpaceA" (ByVal lpRootPathName As String, lpSectorsPerCluster As Long, lpBytesPerSector As Long, lpNumberOfFreeClusters As Long, lpTotalNumberOfClusters As Long) As Long
Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long
Public Function DriveStatus(ByVal Drive As String) As DRIVE_STATUS
Dim lDriveType As Long, lFreeSpace As Long
Dim lSectorsPerCluster As Long, lBytesPerSector As Long
Dim lFreeClusters As Long, lTotalClusters As Long
Dim sDrive As String
sDrive = Drive
lDriveType = GetDriveType(sDrive)
If lDriveType = 1 Then
DriveStatus = DRIVE_DOESNT_EXIST
Else
lFreeSpace = GetDiskFreeSpace(sDrive, lSectorsPerCluster, lBytesPerSector, lFreeClusters, lTotalClusters)
DriveStatus = IIf(Err.LastDllError > 0, DRIVE_NOT_READY, DRIVE_READY)
End If
End Function
'###END OF MODULE###
Then after shelling your DOS command, place the following code:
'###START OF CODE###
Dim StartTime as Long
Dim TimeOut as Integer
StartTime = Timer
TimeOut = 8 'Replace 8 with your desired timeout value (in seconds)
Do Until DriveStatus("M:\") = 3
If (Timer > (StartTime + TimeOut)) Or (Timer < StartTime And (Timer + 86400) > (StartTime + Timeout)) Then
Dim Response As VbMsgBoxResult
Response = MsgBox("Process timed out." & vbCrLf & "Return value = " & Str(DriveStatus("M:\")), vbCritical + vbRetryCancel, "Error Mapping Drive")
If Response = vbRetry Then
StartTime = Timer
Else
End 'Can be replaced with your own piece of code to overcome the problem of a none existant M:\ drive
End If
End If
Loop
'###END OF CODE###
Should work. It will keep checking to see if the drive exists until it does exist (in which case your code continues after the loop,) or until it times out (in which case the a message box will appear asking whether the user wishes to retry and wait a little longer, or cancels and ends the application (or runs code that replaces 'End'.)
Even if you do use code that waits for the DOS command to complete, id still recommend this as it functions as a great lil error handler.
Place this in a module:
'### START OF MODULE ###
Option Explicit
Public Enum DRIVE_STATUS
DRIVE_DOESNT_EXIST = 1
DRIVE_NOT_READY = 2
DRIVE_READY = 3
End Enum
Private Declare Function GetDiskFreeSpace Lib "kernel32" Alias "GetDiskFreeSpaceA" (ByVal lpRootPathName As String, lpSectorsPerCluster As Long, lpBytesPerSector As Long, lpNumberOfFreeClusters As Long, lpTotalNumberOfClusters As Long) As Long
Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long
Public Function DriveStatus(ByVal Drive As String) As DRIVE_STATUS
Dim lDriveType As Long, lFreeSpace As Long
Dim lSectorsPerCluster As Long, lBytesPerSector As Long
Dim lFreeClusters As Long, lTotalClusters As Long
Dim sDrive As String
sDrive = Drive
lDriveType = GetDriveType(sDrive)
If lDriveType = 1 Then
DriveStatus = DRIVE_DOESNT_EXIST
Else
lFreeSpace = GetDiskFreeSpace(sDrive, lSectorsPerCluster, lBytesPerSector, lFreeClusters, lTotalClusters)
DriveStatus = IIf(Err.LastDllError > 0, DRIVE_NOT_READY, DRIVE_READY)
End If
End Function
'###END OF MODULE###
Then after shelling your DOS command, place the following code:
'###START OF CODE###
Dim StartTime as Long
Dim TimeOut as Integer
StartTime = Timer
TimeOut = 8 'Replace 8 with your desired timeout value (in seconds)
Do Until DriveStatus("M:\") = 3
If (Timer > (StartTime + TimeOut)) Or (Timer < StartTime And (Timer + 86400) > (StartTime + Timeout)) Then
Dim Response As VbMsgBoxResult
Response = MsgBox("Process timed out." & vbCrLf & "Return value = " & Str(DriveStatus("M:\")), vbCritical + vbRetryCancel, "Error Mapping Drive")
If Response = vbRetry Then
StartTime = Timer
Else
End 'Can be replaced with your own piece of code to overcome the problem of a none existant M:\ drive
End If
End If
Loop
'###END OF CODE###
Should work. It will keep checking to see if the drive exists until it does exist (in which case your code continues after the loop,) or until it times out (in which case the a message box will appear asking whether the user wishes to retry and wait a little longer, or cancels and ends the application (or runs code that replaces 'End'.)
Even if you do use code that waits for the DOS command to complete, id still recommend this as it functions as a great lil error handler.
SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ARGH! same code! i obviously havent quite woken up yet :S
sorry bout that... THIS is the working code!
'###START OF CODE###
Dim StartTime As Long
Dim TimeOut As Integer
StartTime = Timer - 1
TimeOut = 8 'Replace 8 with your desired timeout value (in seconds)
Do Until DriveStatus("M:\") = 3
If (Timer > (StartTime + TimeOut)) Or (Timer < StartTime And (Timer + 86400) > (StartTime + TimeOut)) Then
Dim Response As VbMsgBoxResult
Response = MsgBox("Process timed out." & vbCrLf & "Return value = " & Str(DriveStatus("M:\")), vbCritical + vbRetryCancel, "Error Mapping Drive")
If Response = vbRetry Then
StartTime = Timer - 1
Else
End 'Can be replaced with your own piece of code to overcome the problem of a none existant M:\ drive
End If
End If
DoEvents
Loop
MsgBox "Drive present!" 'Only here for test puposes, can be removed on your finished app.
'###END OF CODE###
Thats better..........
sorry bout that... THIS is the working code!
'###START OF CODE###
Dim StartTime As Long
Dim TimeOut As Integer
StartTime = Timer - 1
TimeOut = 8 'Replace 8 with your desired timeout value (in seconds)
Do Until DriveStatus("M:\") = 3
If (Timer > (StartTime + TimeOut)) Or (Timer < StartTime And (Timer + 86400) > (StartTime + TimeOut)) Then
Dim Response As VbMsgBoxResult
Response = MsgBox("Process timed out." & vbCrLf & "Return value = " & Str(DriveStatus("M:\")), vbCritical + vbRetryCancel, "Error Mapping Drive")
If Response = vbRetry Then
StartTime = Timer - 1
Else
End 'Can be replaced with your own piece of code to overcome the problem of a none existant M:\ drive
End If
End If
DoEvents
Loop
MsgBox "Drive present!" 'Only here for test puposes, can be removed on your finished app.
'###END OF CODE###
Thats better..........
