Solved

Preventing VB to continue when shelled to a Dos Application

Posted on 1998-11-26
4
227 Views
Last Modified: 2008-03-03
O.K. I know how to shell to an application and prevent the VB from continuing in a Windows 16 bit environment:
Declare Function GetModuleUseage% Lib "Kernel" (by Val hModule%)
Function LaunchApp(appname As String) As Integer
    Static iRet%, iRet2%
    iRet% = Shell(appname, vbMaximizedFocus)
    On Error GoTo launch
    While GetModuleUsage(iRet%)
        iRet2% = DoEvents()
    Wend
launch:
    LaunchApp = iRet%
End Function

But how do I do it in a 32 bit application?

GetModuleUsage is not apart of the Kernel32 library :(

0
Comment
Question by:lohvinenko
  • 2
4 Comments
 
LVL 14

Expert Comment

by:waty
ID: 1446975
Here is a useful bas file containing all your need

Option Explicit

' File and Disk functions.
Private Const DRIVE_CDROM = 5
Private Const DRIVE_FIXED = 3
Private Const DRIVE_RAMDISK = 6
Private Const DRIVE_REMOTE = 4
Private Const DRIVE_REMOVABLE = 2
Private Const DRIVE_UNKNOWN = 0    'Unknown, or unable to be determined.

Private Declare Function GetDriveTypeA Lib "kernel32" (ByVal nDrive As String) As Long

Private Declare Function GetVolumeInformation& Lib "kernel32" Alias "GetVolumeInformationA" (ByVal lpRootPathName As String, ByVal pVolumeNameBuffer As String, ByVal nVolumeNameSize As Long, lpVolumeSerialNumber As Long, lpMaximumComponentLength As Long, lpFileSystemFlags As Long, ByVal lpFileSystemNameBuffer As String, ByVal nFileSystemNameSize As Long)
Private Declare Function GetWindowsDirectoryA Lib "kernel32" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Private Declare Function GetTempPathA Lib "kernel32" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Private Declare Function GetTempFileNameA Lib "kernel32" (ByVal lpszPath As String, ByVal lpPrefixString As String, ByVal wUnique As Long, ByVal lpTempFileName As String) As Long
Private Declare Function GetSystemDirectoryA Lib "kernel32" (ByVal lpBuffer As String, ByVal nSize As Long) As Long

Private Const UNIQUE_NAME = &H0

Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpdirectory As String, ByVal nShowCmd As Long) As Long

Private Const SW_HIDE = 0             ' = vbHide
Private Const SW_SHOWNORMAL = 1       ' = vbNormal
Private Const SW_SHOWMINIMIZED = 2    ' = vbMinimizeFocus
Private Const SW_SHOWMAXIMIZED = 3    ' = vbMaximizedFocus
Private Const SW_SHOWNOACTIVATE = 4   ' = vbNormalNoFocus
Private Const SW_MINIMIZE = 6         ' = vbMinimizedNofocus

Private Declare Function GetShortPathNameA Lib "kernel32" (ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long

Private Type SHFILEOPSTRUCT
   hwnd           As Long
   wFunc          As Long
   pFrom          As String
   pTo            As String
   fFlags         As Integer
   fAborted       As Boolean
   hNameMaps      As Long
   sProgress      As String
End Type

Private Const FO_DELETE = &H3
Private Const FOF_ALLOWUNDO = &H40
Private Const FOF_SILENT = &H4
Private Const FOF_NOCONFIRMATION = &H10

Private Declare Function SHFileOperation Lib "shell32.dll" Alias "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long

Private Type STARTUPINFO
   cb                As Long
   lpReserved        As String
   lpDesktop         As String
   lpTitle           As String
   dwX               As Long
   dwY               As Long
   dwXSize           As Long
   dwYSize           As Long
   dwXCountChars     As Long
   dwYCountChars     As Long
   dwFillAttribute   As Long
   dwFlags           As Long
   wShowWindow       As Integer
   cbReserved2       As Integer
   lpReserved2       As Long
   hStdInput         As Long
   hStdOutput        As Long
   hStdError         As Long
End Type

Private Type PROCESS_INFORMATION
   hProcess As Long
   hThread As Long
   dwProcessID As Long
   dwThreadID As Long
End Type

Private Const NORMAL_PRIORITY_CLASS = &H20&
Private Const INFINITE = -1&
Private Const SYNCHRONIZE = &H100000

Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessID As Long) As Long
Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Private Declare Function CreateProcessA Lib "kernel32" (ByVal lpApplicationName As Long, ByVal lpCommandLine As String, ByVal lpProcessAttributes As Long, ByVal lpThreadAttributes As Long, ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, ByVal lpEnvironment As Long, ByVal lpCurrentDirectory As Long, lpStartupInfo As STARTUPINFO, lpProcessInformation As PROCESS_INFORMATION) As Long
Private Declare Function FindExecutableA Lib "shell32.dll" (ByVal lpFile As String, ByVal lpdirectory As String, ByVal lpResult As String) As Long
Private Declare Function SetVolumeLabelA Lib "kernel32" (ByVal lpRootPathName As String, ByVal lpVolumeName As String) As Long

' *** Get running applications
Private Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long
Private Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hwnd As Long) As Long
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long

Const GW_CHILD = 5
Const GW_HWNDFIRST = 0
Const GW_HWNDLAST = 1
Const GW_HWNDNEXT = 2
Const GW_HWNDPREV = 3
Const GW_MAX = 5
Const GW_OWNER = 4

' *** Infos about files
Private Declare Function OpenFile Lib "kernel32" (ByVal lpFileName As String, lpReOpenBuff As OFSTRUCT, ByVal wStyle As Long) As Long
Private Declare Function GetFileInformationByHandle Lib "kernel32" (ByVal hFile As Long, lpFileInformation As BY_HANDLE_FILE_INFORMATION) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long

Public Const OFS_MAXPATHNAME = 128
Public Const OF_READ = &H0

Type OFSTRUCT
   cBytes As Byte
   fFixedDisk As Byte
   nErrCode As Integer
   Reserved1 As Integer
   Reserved2 As Integer
   szPathName(OFS_MAXPATHNAME) As Byte
End Type

Type FILETIME
   dwLowDateTime As Long
   dwHighDateTime As Long
End Type

Type BY_HANDLE_FILE_INFORMATION
   dwFileAttributes As Long
   ftCreationTime As FILETIME
   ftLastAccessTime As FILETIME
   ftLastWriteTime As FILETIME
   dwVolumeSerialNumber As Long
   nFileSizeHigh As Long
   nFileSizeLow As Long
   nNumberOfLinks As Long
   nFileIndexHigh As Long
   nFileIndexLow As Long
End Type

' *** RegisterAsServiceProcess
Public Declare Function RegisterServiceProcess Lib "kernel32.dll" (ByVal dwProcessID As Long, ByVal dwType As Long) As Long
Public Declare Function GetCurrentProcessId Lib "kernel32.dll" () As Long

Public Function FindExecutable(s As String) As String
   '  Finds the executable associated with a file
   '
   '  Returns "" if no file is found.
   
   Dim i As Integer
   Dim s2 As String

   s2 = String(256, 32) & Chr$(0)

   i = FindExecutableA(s & Chr$(0), vbNullString, s2)

   If i > 32 Then
      FindExecutable = Left$(s2, InStr(s2, Chr$(0)) - 1)
   Else
      FindExecutable = ""
   End If

End Function

Public Function ShellDelete(ParamArray vntFileName() As Variant) As Boolean
   '
   '  Deletes a single file, or an array of files to the trashcan.
   '
   Dim i As Integer
   Dim sFileNames As String
   Dim SHFileOp As SHFILEOPSTRUCT

   For i = LBound(vntFileName) To UBound(vntFileName)
      sFileNames = sFileNames & vntFileName(i) & vbNullChar
   Next

   sFileNames = sFileNames & vbNullChar

   With SHFileOp
      .wFunc = FO_DELETE
      .pFrom = sFileNames
      .fFlags = FOF_ALLOWUNDO + FOF_SILENT + FOF_NOCONFIRMATION
   End With

   i = SHFileOperation(SHFileOp)

   If i = 0 Then
      ShellDelete = True
   Else
      ShellDelete = False
   End If
   
End Function

Public Function ShellWait(cCommandLine As String) As Boolean
   ' #VBIDEUtils#************************************************************
   ' * Programmer Name  : Waty Thierry
   ' * Web Site         : www.geocities.com/ResearchTriangle/6311/
   ' * E-Mail           : waty.thierry@usa.net
   ' * Date             : 2/10/98
   ' * Time             : 09:48
   ' * Module Name      : Execute_Module
   ' * Module Filename  : Execute.bas
   ' * Procedure Name   : ShellWait
   ' * Parameters       :
   ' *                    cCommandLine As String
   ' **********************************************************************
   ' * Comments         :
   ' * Runs a command as the Shell command does but waits for the command
   ' * to finish before returning.  Note: The full path and filename extention
   ' * is required.
   ' * You might want to use Environ$("COMSPEC") & " /c " & command
   ' * if you wish to run it under the command shell (and thus it)
   ' * will search the path etc...
   ' *
   ' * returns false if the shell failed
   ' *
   ' **********************************************************************
   
   Dim NameOfProc    As PROCESS_INFORMATION
   Dim NameStart     As STARTUPINFO
   Dim i             As Long

   NameStart.cb = Len(NameStart)
   i = CreateProcessA(0&, cCommandLine, 0&, 0&, 1&, NORMAL_PRIORITY_CLASS, 0&, 0&, NameStart, NameOfProc)

   If i <> 0 Then
      Call WaitForSingleObject(NameOfProc.hProcess, INFINITE)
      Call CloseHandle(NameOfProc.hProcess)
      ShellWait = True
   Else
      ShellWait = False
   End If

End Function

Public Sub MonitorProcess(sProcess As String)
   ' *** check if another application is still running

   Dim pId        As Long
   Dim pHnd       As Long

   pId = Shell(sProcess, vbNormalFocus)

   pHnd = OpenProcess(SYNCHRONIZE, 0, pId) ' get Process Handle
   If pHnd <> 0 Then
      Call WaitForSingleObject(pHnd, INFINITE) ' Wait until shelled prog ends
      Call CloseHandle(pHnd)
   End If

End Sub

Public Function ExecuteWait(s As String, Optional Param As Variant) As Boolean
   '
   '  As the Execute function but waits for the process to finish before
   '  returning
   '
   '  returns true on success.
   
   Dim s2 As String

   s2 = FindExecutable(s)

   If s2 <> "" Then
      ExecuteWait = ShellWait(s2 & IIf(IsMissing(Param), " ", " " & CStr(Param) & " ") & s)
   Else
      ExecuteWait = False
   End If
   
End Function

Public Function AddBackslash(s As String) As String
   '
   '  Adds a backslash if the string doesn't have one already.
   '
   
   If Len(s) > 0 Then
      If Right$(s, 1) <> "\" Then
         AddBackslash = s + "\"
      Else
         AddBackslash = s
      End If
   Else
      AddBackslash = "\"
   End If

End Function

Public Function ExecuteWithAssociate(ByVal hwnd As Long, sExecute As String, Optional Param As Variant, Optional windowstyle As Variant) As Boolean
   ' #VBIDEUtils#************************************************************
   ' * Programmer Name  : Waty Thierry
   ' * Web Site         : www.geocities.com/ResearchTriangle/6311/
   ' * E-Mail           : waty.thierry@usa.net
   ' * Date             : 9/10/98
   ' * Time             : 11:48
   ' * Module Name      : Execute_Module
   ' * Module Filename  : Execute.bas
   ' * Procedure Name   : ExecuteWithAssociate
   ' * Parameters       :
   ' *                    ByVal hWnd As Long
   ' *                    S As String
   ' *                    Optional Param As Variant
   ' *                    Optional windowstyle As Variant
   ' **********************************************************************
   ' * Comments         :
   ' * Executes a file with it's associated program.
   ' *   windowstyle uses the same constants as the Shell function:
   ' *      vbHide   0
   ' *      vbNormalFocus  1
   ' *      vbMinimizedFocus  2
   ' *      vbMaximizedFocus  3
   ' *      vbNormalNoFocus   4
   ' *      vbMinimizedNoFocus   6
   ' *
   ' *  returns true on success
   ' *
   ' *
   ' **********************************************************************
   
   Dim i As Long

   If IsMissing(windowstyle) Then windowstyle = vbNormalFocus

   i = ShellExecute(hwnd, vbNullString, sExecute, IIf(IsMissing(Param) Or (Param = ""), vbNullString, CStr(Param)), GetPath(sExecute), CLng(windowstyle))
   If i > 32 Then
      ExecuteWithAssociate = True
   Else
      ExecuteWithAssociate = False
   End If
   
End Function

Public Function GetFile(s As String) As String
   '
   '  Returns the file portion of a file + pathname
   '
   
   Dim i As Integer
   Dim J As Integer

   i = 0
   J = 0

   i = InStr(s, "\")
   Do While i <> 0
      J = i
      i = InStr(J + 1, s, "\")
   Loop

   If J = 0 Then
      GetFile = ""
   Else
      GetFile = Right$(s, Len(s) - J)
   End If

End Function

Public Function GetPath(s As String) As String
   '
   '  Returns the path portion of a file + pathname
   '
   
   Dim i As Integer
   Dim J As Integer

   i = 0
   J = 0

   i = InStr(s, "\")
   Do While i <> 0
      J = i
      i = InStr(J + 1, s, "\")
   Loop

   If J = 0 Then
      GetPath = ""
   Else
      GetPath = Left$(s, J)
   End If

End Function

Public Function GetSerialNumber(sDrive As String) As Long
   ' *** Retrieve a disks serial number
   ' *** Whenever a disk is formatted, the operating system writes a serial number onto it.
   ' *** This number is not guaranteed to be unique, but as it is a 32 bit integer
   ' *** it is unlikely to find a duplicate!
   ' *** The number is often used as part of a copy protection system.

   Dim nSerial       As Long
   Dim sTmp          As String * 256
   Dim sTmp2         As String * 256
   Dim nI            As Long
   Dim nJ            As Long

   sTmp = String$(255, Chr$(0))
   sTmp2 = String$(255, Chr$(0))
   Call GetVolumeInformation(sDrive + ":\" & Chr$(0), sTmp, 256, nSerial, nI, nJ, sTmp2, 256)
   GetSerialNumber = nSerial

End Function

Public Function GetSerialNumber2() As String
   '
   '  Returns a volume's serial number
   '
   Dim lpReOpenBuff       As OFSTRUCT
   Dim FileHandle         As Long
   Dim FileInfo           As BY_HANDLE_FILE_INFORMATION
   Dim ret As Long

   FileHandle = OpenFile("c:\autoexec.bat", lpReOpenBuff, OF_READ)
   ret = GetFileInformationByHandle(FileHandle, FileInfo)
   GetSerialNumber2 = CStr(FileInfo.dwVolumeSerialNumber)
   ret = CloseHandle(FileHandle)

End Function

Public Function GetShortPathName(longpath As String) As String
   Dim s As String
   Dim i As Long

   i = Len(longpath) + 1
   s = String(i, 0)
   GetShortPathNameA longpath, s, i

   GetShortPathName = Left$(s, InStr(s, Chr$(0)) - 1)
End Function

Public Function GetVolumeName(sDrive As String) As String
   Dim ser As Long
   Dim s As String * 256
   Dim s2 As String * 256
   Dim i As Long
   Dim J As Long

   Call GetVolumeInformation(sDrive + ":\" & Chr$(0), s, 256, ser, i, J, s2, 256)
   GetVolumeName = Left$(s, InStr(s, Chr$(0)) - 1)
End Function

Public Function SetVolumeName(sDrive As String, n As String) As Boolean
   '
   '  Sets the volume name.  Returns true on success, false on failure.
   '
   Dim i As Long

   i = SetVolumeLabelA(sDrive + ":\" & Chr$(0), n & Chr$(0))

   SetVolumeName = IIf(i = 0, False, True)
End Function

Public Function GetSystemDirectory() As String
   '
   '  Returns the system directory.
   '
   Dim s As String
   Dim i As Integer
   i = GetSystemDirectoryA("", 0)
   s = Space(i)
   Call GetSystemDirectoryA(s, i)
   GetSystemDirectory = AddBackslash(Left$(s, i - 1))
End Function

'
'  Returns the path to the temp directory.
'
Public Function GetTempPath() As String
   Dim s As String
   Dim i As Integer
   i = GetTempPathA(0, "")
   s = Space(i)
   Call GetTempPathA(i, s)
   GetTempPath = AddBackslash(Left$(s, i - 1))
End Function

Public Function GetWindowsDirectory() As String
   '
   '  Returns the windows directory.
   '
   Dim s As String
   Dim i As Integer
   i = GetWindowsDirectoryA("", 0)
   s = Space(i)
   Call GetWindowsDirectoryA(s, i)
   GetWindowsDirectory = AddBackslash(Left$(s, i - 1))
End Function

Public Function RemoveBackslash(s As String) As String
   '
   '  Removes the backslash from the string if it has one.
   '
   Dim i As Integer
   i = Len(s)
   If i <> 0 Then
      If Right$(s, 1) = "\" Then
         RemoveBackslash = Left$(s, i - 1)
      Else
         RemoveBackslash = s
      End If
   Else
      RemoveBackslash = ""
   End If
End Function

Public Function sDriveType(sDrive As String) As String
   '
   ' Returns the drive type if possible.
   '
   Dim lRet As Long

   lRet = GetDriveTypeA(sDrive & ":\")
   Select Case lRet
      Case 0
         'sDriveType = "Cannot be determined!"
         sDriveType = "Unknown"

      Case 1
         'sDriveType = "The root directory does not exist!"
         sDriveType = "Unknown"
      Case DRIVE_CDROM:
         sDriveType = "CD-ROM Drive"

      Case DRIVE_REMOVABLE:
         sDriveType = "Removable Drive"

      Case DRIVE_FIXED:
         sDriveType = "Fixed Drive"

      Case DRIVE_REMOTE:
         sDriveType = "Remote Drive"
   End Select

End Function

Public Function GetDriveType(sDrive As String) As Long

   Dim lRet As Long
   lRet = GetDriveTypeA(sDrive & ":\")

   If lRet = 1 Then
      lRet = 0
   End If

   GetDriveType = lRet

End Function

Public Sub GetRunningApplications(nhwnd As Long)
   ' *** Show all the running applications

   Dim lLgthChild    As Long
   Dim sNameChild    As String
   Dim lLgthOwner    As Long
   Dim sNameOwner    As String
   Dim lHwnd         As Long
   Dim lHwnd2        As Long
   Dim lProssId   As Long

   Const vbTextCompare = 1

   lHwnd = GetWindow(nhwnd, GW_HWNDFIRST)
   While lHwnd <> 0
      lHwnd2 = GetWindow(lHwnd, GW_OWNER)
      lLgthOwner = GetWindowTextLength(lHwnd2)
      sNameOwner = String$(lLgthOwner + 1, Chr$(0))
      lLgthOwner = GetWindowText(lHwnd2, sNameOwner, lLgthOwner + 1)

      If lLgthOwner <> 0 Then
         sNameOwner = Left$(sNameOwner, InStr(1, sNameOwner, Chr$(0), vbTextCompare) - 1)
         Call GetWindowThreadProcessId(lHwnd2, lProssId)
         Debug.Print sNameOwner, lProssId
      End If

      lLgthChild = GetWindowTextLength(lHwnd)
      sNameChild = String$(lLgthChild + 1, Chr$(0))
      lLgthChild = GetWindowText(lHwnd, sNameChild, lLgthChild + 1)
      If lLgthChild <> 0 Then
         sNameChild = Left$(sNameChild, InStr(1, sNameChild, Chr$(0), vbTextCompare) - 1)
         Call GetWindowThreadProcessId(lHwnd, lProssId)
         Debug.Print sNameChild, lProssId
      End If

      lHwnd = GetWindow(lHwnd, GW_HWNDNEXT)
      DoEvents

   Wend

End Sub

Public Function RegisterAsServiceProcess(bRegister As Boolean) As Boolean
   ' #VBIDEUtils#************************************************************
   ' * Programmer Name  : Waty Thierry
   ' * Web Site         : www.geocities.com/ResearchTriangle/6311/
   ' * E-Mail           : waty.thierry@usa.net
   ' * Date             : 25/09/98
   ' * Time             : 11:36
   ' * Module Name      : Execute
   ' * Module Filename  : Execute_Module
   ' * Procedure Name   : RegisterAsServiceProcess
   ' * Parameters       :
   ' **********************************************************************
   ' * Comments         : This code allows the programer to register
   ' * the application as a service process.
   ' * To put it in simpler terms, a service process does not appear in the "End Task"
   ' * dialog box. Using this call does not let the user of your application terminate
   ' * the program using Ctrl-Alt-Del.
   ' *
   ' **********************************************************************

   RegisterAsServiceProcess = RegisterServiceProcess(GetCurrentProcessId, IIf(bRegister, 1, 0)) = 1

End Function


0
 

Author Comment

by:lohvinenko
ID: 1446976
Wrong answer.

I want to know how to call a dos based application from a shell and have the vb program wait until the process is done.

eg.

taskid = shell( "c:\test\pkzip.exe stuff.zip" , 1 )

while (GetModuleUsage(hMod))
   Do Events
Wend

Problem GetModuleUsage is not part of the kernel32.dll.
this functiononly works in a WIN16 app not a WIN32!
Where do i go from here??

0
 
LVL 1

Accepted Solution

by:
kdimmock earned 100 total points
ID: 1446977
Private Type STARTUPINFO
      cb As Long
      lpReserved As String
      lpDesktop As String
      lpTitle As String
      dwX As Long
      dwY As Long
      dwXSize As Long
      dwYSize As Long
      dwXCountChars As Long
      dwYCountChars As Long
      dwFillAttribute As Long
      dwFlags As Long
      wShowWindow As Integer
      cbReserved2 As Integer
      lpReserved2 As Long
      hStdInput As Long
      hStdOutput As Long
      hStdError As Long
End Type
Private Type PROCESS_INFORMATION
      hProcess As Long
      hThread As Long
      dwProcessID As Long
      dwThreadID As Long
End Type
Private Declare Function WaitForSingleObject Lib "Kernel32" (ByVal _
      hHandle As Long, ByVal dwMilliseconds As Long) As Long
Private Declare Function CreateProcessA Lib "Kernel32" (ByVal _
      lpApplicationName As Long, ByVal lpCommandLine As String, ByVal _
      lpProcessAttributes As Long, ByVal lpThreadAttributes As Long, _
      ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, _
      ByVal lpEnvironment As Long, ByVal lpCurrentDirectory As Long, _
      lpStartupInfo As STARTUPINFO, lpProcessInformation As _
      PROCESS_INFORMATION) As Long
Private Declare Function CloseHandle Lib "Kernel32" (ByVal _
      hObject As Long) As Long
Private Const NORMAL_PRIORITY_CLASS = &H20&
Private Const INFINITE = -1&
Private Const STATUS_TIMEOUT = 258&


Public Sub ExecCmd(cmdline$)

    On Error GoTo Error_Routine
   
   
    Dim proc As PROCESS_INFORMATION
    Dim start As STARTUPINFO
    Dim ret As Long
    ' Initialize the STARTUPINFO structure:
    start.cb = Len(start)
   
    ' Start the shelled application:
    ret = CreateProcessA(0&, cmdline$, 0&, 0&, 1&, _
        NORMAL_PRIORITY_CLASS, 0&, 0&, start, proc)
   
    ' Wait for the shelled application to finish:
   
    Do
        ret = WaitForSingleObject(proc.hProcess, 0&)
        DoEvents
    Loop Until ret <> STATUS_TIMEOUT
   
    ret = CloseHandle(proc.hProcess)

exit_lab:
    Exit Sub
Error_Routine:
    Err.Raise Err.Number, "Common32.ExecCmd:" & Err.Source, Err.Description
End Sub
0
 
LVL 14

Expert Comment

by:waty
ID: 1446978
No, my answer is good, you need to use the "ShellWait" function.
It works perfectly, and I have added more functions for your information.
0

Featured Post

IT, Stop Being Called Into Every Meeting

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

Join & Write a Comment

Introduction While answering a recent question about filtering a custom class collection, I realized that this could be accomplished with very little code by using the ScriptControl (SC) library.  This article will introduce you to the SC library a…
Enums (shorthand for ‘enumerations’) are not often used by programmers but they can be quite valuable when they are.  What are they? An Enum is just a type of variable like a string or an Integer, but in this case one that you create that contains…
Get people started with the process of using Access VBA to control Excel using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Excel. Using automation, an Access application can laun…
Show developers how to use a criteria form to limit the data that appears on an Access report. It is a common requirement that users can specify the criteria for a report at runtime. The easiest way to accomplish this is using a criteria form that a…

747 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

12 Experts available now in Live!

Get 1:1 Help Now