shell调用的外部程序没有运行完就自动结束？

huruigege

Declare Function GetExitCodeProcess Lib "kernel32" (ByVal hProcess As Long, lpExitCode As Long) As Long
    Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
    Public Const Process_Query_Information = &H400
    Public Const Still_Active = 259

Sub 按钮186_单击()

Dim strWinDir As String
    Dim pid As Long
    Dim hProcess As Long
    Dim a As String
  
    a = ThisWorkbook.Path 'Excell文件所在路径。
 
    strWinDir = Environ("windir") '系统目录。
   
    'pid = Shell(strWinDir & "\system32\cmd.exe", 1)
    pid = Shell(a & "\cuihuatiaohe.exe", 1)
    hProcess = OpenProcess(Process_Query_Information, False, pid)
   
    Do
    GetExitCodeProcess hProcess, lngexitcode
    DoEvents
    Loop While lngexitcode = Still_Active
End Sub

以上语句，我执行pid = Shell(strWinDir & "\system32\cmd.exe", 1)
时该cmd窗口可以长时间存在，而我执行pid = Shell(a & "\cuihuatiaohe.exe", 1) 则cuihuatiaohe.exe运行很短的时间马上就自动终止，并没有执行完。我不用VBA调用，直接运行该程序cuihuatiaohe.exe没有任何问题，可以正常运行（大约10秒）。

这是为什么呢？感觉好像是cuihuatiaohe.exe被调用后显示出一行字后就自动中断了。

BobPan

Shell只会调用程序，调用后就会继续执行后面代码。下面代码可让代码等待调用程序结束后再继续执行后面代码，试试：

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 Const INFINITE = &HFFFFFFFF
Private Const PROCESS_QUERY_INFORMATION = &H400
Private Const SYNCHRONIZE = &H100000

Sub test()
    Dim ReturnValue&, hProcess&

    ReturnValue = Shell("Notepad.exe ", vbMaximizedFocus)
    hProcess = OpenProcess(PROCESS_QUERY_INFORMATION + SYNCHRONIZE, 0, ReturnValue)
    WaitForSingleObject hProcess, INFINITE

    MsgBox "您结束了记事本"
End Sub

huruigege

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 Const INFINITE = &HFFFFFFFF
Private Const PROCESS_QUERY_INFORMATION = &H400
Private Const SYNCHRONIZE = &H100000

Sub 按钮186_单击()

Dim strWinDir As String
    Dim pid As Long
    Dim a As String
   
   
   Dim ReturnValue&, hProcess&
  
    a = ThisWorkbook.Path 'Excell文件所在路径。
 
    'strWinDir = Environ("windir") '系统目录。
   
    'pid = Shell(strWinDir & "\system32\cmd.exe", vbNormalFocus)
    'pid = Shell(a & "\cuihuatiaohe.exe", 1)
   
    ReturnValue = Shell(a & "\cuihuatiaohe.exe", vbMaximizedFocus)
    hProcess = OpenProcess(PROCESS_QUERY_INFORMATION + SYNCHRONIZE, 0, ReturnValue)
    WaitForSingleObject hProcess, INFINITE
       
End Sub

根据您的指点修改了程序，但是运行的结果还是一样，cuihuatiaohe.exe程序只是运行很短的时间就马上停止了。应该还有别的原因吧。调用Notepad.exe 确实没有问题。但是调用我自己写的这个程序就不行了，而我自己写的这个程序独立运行的时候没有这个问题，可以很好的运行完。

为什么呢？请您指教。

huruigege

我用单步执行的方式运行VBA也是一样，在读到该shell语句，还没有往下运行的时候，cuihuatiaohe程序也不是运行完，只是运行很短的时间就自动关闭了。

是不是和我所写的程序某些特征有关系？我在独立运行这个程序的时候没有任何问题啊。

BobPan

是否方便上传cuihuatiaohe.exe

huruigege

QUOTE:

以下是引用BobPan在2007-11-6 11:44:52的发言：

是否方便上传cuihuatiaohe.exe

我刚才测试了一下，发现是我的程序的问题，我的程序在调用的时候需要链接到库，但是用VBA调用的时候无法识别库。

我试了好几次，终于抓图成功，知道原因了，谢谢。

出错原因，可参见图片。

我的程序运行需要安装一个库，所以发给您您也打不开的。

[此贴子已经被作者于2007-11-6 11:55:25编辑过]

筱筱zww

huruigege 发表于 2007-11-6 11:54
QUOTE:以下是引用BobPan在2007-11-6 11:44:52的发言：是否方便上传cuihuatiaohe.exe我刚才测试了一下，发现 ...

你好，我现在使用VBA调用外部exe失败，也是窗口出现一会儿就消失，exe也需要调用DLL，跟你遇到的问题一模一样，请问你是怎么解决的啊？很着急，求指导，求指导，很着急，非常感谢