难。谁知道怎么同步方式执行SHELL吗？

注意缺省情况下，Shell 函数是以异步方式来执行其它程序的。也就是说，用 Shell 启动的程序可能还没有完成执行过程，就已经执行到 Shell 函数之后的语句。
我要的是以同步方式执行SHELL，等SHELL执行完本身的命令后再执行后面的命令。

16 个解决方案

#1

Public Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Public Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long

Function StillRun(ByVal ProgramID) As Boolean
Dim lHProgram As Long
Dim lReturn As Long
Dim hProgram As Long
hProgram = 0
hProgram = OpenProcess(0, False, ProgramID)
If Not hProgram = 0 Then
  StillRun = True
Else
  StillRun = False
End If
CloseHandle hProgram
End Function
--------------------------------------------------------------------
使用：
pID = Shell(调用的程序)
While StillRun(pID)
'  DoEvents
Wend

#2

这个是用程序的方式解决这个问题。我想知道WINDOWS本身有没有什么办法同步方式在程序中使用。比如一个什么命令之类的。

#3

我想到用VB做个屏幕保护程序，自动运行杀毒软件，可是用sendkeys触发按钮的时候，屏保就自动关闭了,sendmassage可以代替按键吗？会不会触发键盘鼠标事件？我想触发按钮但不中断屏保程序啊，就是运行金山杀毒并且按一下回车开始杀毒

#4

To superdullwolf
尝试在启动毒霸的时候传一个参数，不模拟按键。

#5

Public Function RunShell(cmdline As String) As Boolean
Dim hProcess As Long
Dim ProcessID As Long
Dim ExitCodeLong As Long
Dim str1 As String
    ProcessID = Shell(cmdline, vbHide)
    hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, False, ProcessID)
    Do
        Call GetExitCodeProcess(hProcess, ExitCodeLong)
        DoEvents
        'If ExitCode Then Exit Do
    Loop While ExitCodeLong = STATUS_PENDING
    Call CloseHandle(hProcess)
    RunShell = True
End Function

#6

use shellexecute or createprocess APIs

#7

WaitForSingleObject

#8

1
利用是利用Win32 API的FindWindow函数。该函数可以搜索指定标题或类的窗口，你可以在调用第一个可执行文件后用FindWindow函数去找指定的窗口，如果找到了，就说明第一个文件还未运行完，等待，直到用FindWindow函数找不到指定窗口，就可执行后续语句。

2
利用Windows API的OpenProcess和CloseHandle函数来实现对被调用软件的检测：
    1) 在VB中新建一个标准EXE工程；
    2) 在Form1中声明OpenProcess和 CloseHandle 这两个Windows API 函数；
     Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal
     bInheritHandle As Long, ByVal dwProcessId As Long) As Long
     Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
    3) 然后编写下面的函数:
     Function IsRunning(ByVal ProgramID) As Boolean ' 传入进程标识ID
     Dim hProgram As Long '被检测的程序进程句柄
     hProgram = OpenProcess(0, False, ProgramID)
     If Not hProgram = 0 Then
     IsRunning = True
     Else
     IsRunning = False
     End If
     CloseHandle hProgram
     End Function
    4) 在Form_Click()中加入代码：
     Sub Form_Click()
     Dim X
     Me.Caption = "开始运行"
     X = Shell("NotePad.EXE", 1)
     While IsRunning(X)
     DoEvents
     Wend
     Me.Caption = "结束运行"
     End Sub

3
利用Win32 API的CreateProcess函数和WaitForSingleObject函数:
首先建立一个模块(module)，然后输入以下语句：
    Option Explicit

    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
    Type PROCESS_INFORMATION
     hProcess As Long
     hThread As Long
     dwProcessID As Long
     dwThreadID As Long
    End Type
    Global Const NORMAL_PRIORITY_CLASS = &H20&
    Global Const INFINITE = -1&
    Declare Function CloseHandle Lib "kernel32" (hObject As Long) As Boolean
    Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
    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

    Public Sub ShellAndWait(cmdline$)
     Dim NameOfProc As PROCESS_INFORMATION
     Dim NameStart As STARTUPINFO
     Dim X As Long

     NameStart.cb = Len(NameStart)
     X = CreateProcessA(0&, cmdline$, 0&, 0&, 1&, NORMAL_PRIORITY_CLASS, _
     0&, 0&, NameStart, NameOfProc)
     X = WaitForSingleObject(NameOfProc.hProcess, INFINITE)
     X = CloseHandle(NameOfProc.hProcess)
    End Sub
    建立一个窗体，并放一个命令按钮(Command1)在其上。在Command1_Click事件中输入以下内容：
    Private Sub Command1_Click()
     Dim AppToLaunch As String

     AppToLaunch = "c:\win95\notepad.exe"
     ShellAndWait AppToLaunch
    End Sub
    运行该程序，按下Command1，就会调用NotePad，在NotePad运行完毕之前，VB程序不会继续执行。你可以在程序中使用ShellAndWait来代替Shell命令。

#9

针对 of123()的回答：
方法1：FindWindow要依赖于程序标题，但标题往往不确定或重复。
方法2：win2k下为何不成功？
方法3：运行良好，可惜shell期间，主程序无响应，容易引起客户困惑。

还有一种方法，不用API：
'引用  Windows  Script  Host  Object  Model
Private Sub Command1_Click()
    Dim x   As New IWshRuntimeLibrary.IWshShell_Class
    Me.Enabled = False
    x.Run x.ExpandEnvironmentStrings("%WinDir%") & "\notepad.exe", , True
    VBA.MsgBox "执行完毕"
    x.Run "CALC.EXE", , True
    VBA.MsgBox "执行完毕"
    Me.Enabled = True
End Sub

#10

不过也有缺点：
win2k下有些电脑不成功，
因为wshom.ocx接口有问题，但win2k的系统文件保护机制不允许替换这个文件~~

#11

方法2试验成功：

hProgram = OpenProcess(0, False, ProgramID)
替换为：
hProgram = OpenProcess(&H1F0FFF, False, ProgramID)

#12

Option Explicit

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 dcWaitForSingleObject Lib "kernel32" Alias "WaitForSingleObject" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long

Private Declare Function dcCreateProcess Lib "kernel32" Alias "CreateProcessA" (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 dcCloseHandle Lib "kernel32" Alias "CloseHandle" (ByVal hObject As Long) As Long

Private Declare Function dcGetExitCodeProcess Lib "kernel32" Alias "GetExitCodeProcess" (ByVal hProcess As Long, lpExitCode As Long) As Long
Public Declare Function dcTerminateProcess Lib "kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long

Private Const NORMAL_PRIORITY_CLASS = &H20&
Private Const INFINITE = -1&
Const WAIT_TIMEOUT As Long = &H102

Public Function ExecCmd(cmdline$)
   Dim proc As PROCESS_INFORMATION
   Dim start As STARTUPINFO
   Dim ret As Long
   Dim enAllFail As Long

   On Error GoTo errExit

   ' Initialize the STARTUPINFO structure:
   start.cb = Len(start)

   ' Start the shelled application:
   ret = dcCreateProcess(0&, cmdline$, 0&, 0&, 1&, _
   NORMAL_PRIORITY_CLASS, 0&, 0&, start, proc)

   ' Wait for the shelled application to finish:
   ret = dcWaitForSingleObject(proc.hProcess, INFINITE)
   If ret = WAIT_TIMEOUT Then
       'After 15 min program may be hung?
       Call dcTerminateProcess(proc.hProcess, enAllFail)
   End If
   Call dcGetExitCodeProcess(proc.hProcess, ret&)
   Call dcCloseHandle(proc.hProcess)
   ExecCmd = ret&
   Exit Function
errExit:
   'Error handler here

End Function

#13

xuexi!

#14

re: JennyVenus()
WaitForSingleObject的第二的参数是不能用INFINITE，否则他会一直等待下去，一直等到
proc.hProcess close为止，我认为应当为他设置一个值，然后判断
If ret = WAIT_TIMEOUT then

#15

如下处理不行吗？
x=Shell("XXXXXXXXX")
Do while x=0
Doevents
loop

#16

最简单的方法：

Private Sub Command1_Click()
Dim mShell As Object

Set mShell = CreateObject("wscript.shell")
mShell.Run "c:\windows\calc.exe", 8, True

MsgBox "ok"

End Sub

#1

#2