Office中国论坛/Access中国论坛

标题: access 调用程序问题 [打印本页]

---

作者: erin_lyj    时间: 2006-10-23 19:53
标题: access 调用程序问题
现在需要通过一个按钮调用两个程序，我用两个call命令分别调用，但我发现两个程序是同时调用的，我希望执行完一个程序在执行另一个程序，如何解决呢？

Dim stAppNametransfer As String

    stAppNametrans = "d:\trans.bat"
   
    Call Shell(stAppNametrans, 1)
   
    Dim stAppName1 As String

    stAppNamersh = "c:\program files\1.exe"
   
    Call Shell(stAppName1, 1)

---

作者: 一点通    时间: 2006-10-24 00:29
另一个程序放在"计时器触发"事件中,利用"计时器间隔"来执行

---

作者: fan0217    时间: 2006-10-24 03:46
Shell执行程序是异步执行的，所以不能实现你的要求，当然这也不是没有办法。

摘自：access911.net

方法1：

我们用shell()来执行外部的程序时，一旦shell启动了外部程序后无论外部程序是否已经运行完毕，Access 都会继续执行 shell 语句下面的 VBA 程序。若要 Access 等待 shell() 调用的外部程序执行完毕后再继续执行下面的 VBA 程序可使用以下方法：









'以下语句加入窗体声明段
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredaccess&, ByVal bInherithandle&, ByVal dwProcessid&) As Long
Private Declare Function GetExitCodeProcess Lib "kernel32" (ByVal hProcess As Long, lpexitcode As Long) As Long
Const STILL_ACTIVE = &H103
Const PROCESS_QUERY_INFORMATION = &H400



Dim hShell As Long
Dim hProc As Long
Dim lExit As Long









'更改您的shell语句为如下格式：
    hShell = Shell("RunExeFile", 1)



    hProc = OpenProcess(PROCESS_QUERY_INFORMATION, False, hShell)
   
    If hShell = 0 Then MsgBox "程序执行失败"

    Do
        GetExitCodeProcess hProc, lExit
        DoEvents
    Loop While lExit = STILL_ACTIVE

    MsgBox "Shell 语句执行完毕"

方法2：

将下列代码粘贴到一个新模块中，并使用ShellWait过程调用外部程序。





<TABLE 100%" cellSpacing=1 cellPadding=5>



<TR>

<TD #81a9e8 1px solid; PADDING-RIGHT: 10px; BORDER-TOP: #81a9e8 1px solid; MARGIN-TOP: 0px; PADDING-LEFT: 10px; PADDING-BOTTOM: 10px; BORDER-LEFT: #81a9e8 1px solid; COLOR: #00284d; PADDING-TOP: 10px; BORDER-BOTTOM: #81a9e8 1px solid; BACKGROUND-COLOR: #f2f2f2; TEXT-DECORATION: none" width="100%">'***************** Code Start ******************
'This code was originally written by Terry Kreft.
'It is not to be altered or distributed,
'except as part of an application.
'You are free to use it in any application,
'provided the copyright notice is left unchanged.
'
'Code Courtesy of
'Terry Kreft
Private Const STARTF_USESHOWWINDOW& = &H1
Private Const NORMAL_PRIORITY_CLASS = &H20&
Private Const INFINITE = -1&



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, lpProcessInformat

---

欢迎光临 Office中国论坛/Access中国论坛 (http://www.office-cn.net/)

Powered by Discuz! X3.3