VBA中调用CMD问题
我现在想把cmd中运行出来的内容导入到一个txt文本中去,但是每次导入的时候会有响应的延迟,
我必须等待零点几秒来让他完成导入,请问有什么办法能够在程序中确切知道cmd已经确切完成了导入。好让我获取txt中的内容?
[解决办法]
shell的等待么?
Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As LongPrivate Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As LongPrivate Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As LongPrivate Const INFINITE = -1&Private Const SYNCHRONIZE = &H100000'以上代码需要写在顶层Private Sub ShellWait()Dim iTask As Long, ret As Long, pHandle As LongiTask = Shell("notepad.exe", vbNormalFocus)pHandle = OpenProcess(SYNCHRONIZE, False, iTask)ret = WaitForSingleObject(pHandle, INFINITE)ret = CloseHandle(pHandle)MsgBox "结束!"End Sub
[解决办法]
如果你这是在可以调用API的VB6或OFFICE中的宏VBA中执行,那就简单许多,参考:
http://blog2.m5home.com/blogview.asp?logID=411
'*************************************************************************'**模 块 名:ModShellEx'**说 明:增强SHELL函数'**创 建 人:马大哈'**描 述:紫水晶工作室 http://www.m5home.com/'**日 期:2007年4月24日'**版 本:V1.0'*************************************************************************Option ExplicitPrivate Declare Function GetProcessVersion Lib "kernel32" (ByVal ProcessId As Long) As LongPrivate Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)Public Function ShellEx(ByVal FileName As String, Optional ByVal WindowStyle As VbAppWinStyle = vbNormalFocus, Optional ByVal DelayTime As Long = -1) '与SHELL函数一样的参数,不过是阻塞执行.(同步) 'FileName - 目标文件名 'WindowStyle - 程序运行时窗口的样式 'DelayTime - 等待的时间,单位为ms '备注: ' DelayTime设置为-1时表示一直等待,直到目标程序运行结束 Dim I As Long, J As Long I = Shell(FileName, WindowStyle) Do If GetProcessVersion(I) = 0 Then Exit Do Sleep 10 J = J + 1 If DelayTime <> -1 And J > DelayTime \ 10 Then Exit Do LoopEnd FunctionPublic Function ShellOnce(ByVal FileName As String, Optional ByVal WindowStyle As VbAppWinStyle = vbNormalFocus) '与SHELL函数一样的参数,但只将目标执行一次 'FileName - 目标文件名 'WindowStyle - 程序运行时窗口的样式 Static I As Long If I <> 0 Then '如果有PID值就判断其是否正在执行 If GetProcessVersion(I) <> 0 Then Exit Function '如果正在执行,函数返回 End If I = Shell(FileName, WindowStyle)End Function