作者：绿色风
分类：
时间：2022-08-18
浏览：57
楼主
omnw |
我们经常会使用Shell来执行外部程序，由于Shell是按照异步方式执行程序，会使我们的程序出现错误，而且查询原因也很复杂。下面的代码可以Shell实现同步执行的效果。
- 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
- Sub Shell_T()
- Dim hShell As Long
- Dim hProc As Long
- Dim lExit As Long
- 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 语句执行完毕"
- End Sub
注：RunExeFile代表要执行的程序名，以及任何必需的参数或命令行变量，可能还包括目录或文件夹，以及驱动器。 |
2楼
omnw |
Shell 函数是以异步方式来执行其它程序的。也就是说，用 Shell 启动的程序可能还没有完成执行过程，就已经执行到 Shell 函数之后的语句。这样就会造成实际的结果与设计不相符，如下代码：- Shell "cmd.exe /c del " & ThisWorkbook.Path & "\结果.txt"
- Open ThisWorkbook.Path & "\结果.txt" For Binary As #1
- Put #1, , Join(s, vbCrLf)
- Close #1
就会出现open语句生成的“结果.txt”文件被Shell删除的结果。
为了解决“异步”问题，可以借助API函数来监测Shell进程是否已经运行结束，然后再运行下面的代码，达到“同步”的效果。这样将上面的代码改造如下：- Option Explicit
- 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
- Sub DelFile()
- Dim i As Integer
- Dim cmd As String
- Const STILL_ACTIVE = &H103
- Const PROCESS_QUERY_INFORMATION = &H400
- Dim hShell As Long
- Dim hProc As Long
- Dim lExit As Long
-
- cmd = "cmd.exe /c del " & ThisWorkbook.Path & "\结果.txt"
- hShell = Shell(cmd, 0)
- hProc = OpenProcess(PROCESS_QUERY_INFORMATION, False, hShell)
- If hShell = 0 Then
- MsgBox "error"
- Else
- Do
- GetExitCodeProcess hProc, lExit
- DoEvents
- Loop While lExit = STILL_ACTIVE
- Open ThisWorkbook.Path & "\结果.txt" For Binary As #1
- ' Put #1, , Join(s, vbCrLf)
- Close #1
- End If
- End Sub
|
3楼
yinxingshu |
居然还有这个问题，不可思议！ |
4楼
水星钓鱼 |
学习 |
免责声明
有感于原ExcelTip.Net留存知识的价值及部分知识具有的时间限定性因素，
经与ExcelTip.Net站长Apolloh商议并征得其同意，
现将原属ExcelTip.Net的知识帖采集资料于本站点进行展示，
供有需要的人士查询使用，也慰缅曾经的论坛时代。
所示各个帖子的原作者如对版权有异议，
可与本人沟通提出，或于本站点留言，我们会尽快处理。
在此，感谢ExcelTip.Net站长Apolloh的支持，感谢本站点所有人**绿色风（QQ:79664738)**的支持与奉献，特此鸣谢！
------本人网名**KevinChengCW（QQ:1210618015)**原ExcelTip.Net总版主之一