|
|
本帖最后由 ndt3 于 2022-8-22 14:18 编辑
各位老师：
工作流程原因需要vba控制pdfFactory pro的关闭。
现在能找到pdfFactory pro的句柄及关闭pdfFactory pro。但页数较多时pdfFactory pro未完全执行完成就会被关闭。
盖火思路想通过pdfFactory pro的标题来检查是否完成任务，完成后再关闭。
pdfFactory pro在执行中如果未完全执行完毕标题会有 “**%完成” 显示，（完成后pdfFactory pro无前述字样）但始终无法通过句柄获取正确的标题数据。
请教各位老师，烦劳各位老师能帮忙看看。十分感谢！
目前测试集中方法都失败，无法实现虚拟打印机执行完成后关闭pdfFactory pro程序。代码如下，求助哪位老师帮忙看看！十分感谢！
Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Public Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Public Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Declare Function GetDlgCtrlID Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetFocus Lib "user32" () As Long
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hwnd As Long) As Long
'发送消息使用
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Any) As Long
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function ReadProcessMemory Lib "kernel32" (ByVal hProcess As Long, lpBaseAddress As Any, lpBuffer As Any, ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Public Declare PtrSafe Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
#If Win64 Then
Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare PtrSafe Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
#Else
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
#End If
'拿到进程的运行状态并传递给第二个参数。第一个参数为处理器
Private Declare Function GetExitCodeProcess Lib "kernel32" (ByVal hProcess As Long, lpExitCode As Long) As Long '方案2
Const PROCESS_QUERY_INFORMATION = &H400 '十进制是1024'方案2
Const STILL_ALIVE = &H103 '十进制529 表明进程仍然存活'方案2
Const PROCESS_ALL_ACCESS = &H1F0FFF = 2035711
Const VK_Ctrl = &H11
Const VK_S = &H53
Const KEYEVENTF_KEYUP = &H2 'A
Const WM_KEYDOWN = &H100
Const WM_CLOSE = &H10
Const WAIT_TIMEOUT = &H102
Dim Excelhandle As Long
'------------以上为定义----------------
Sub smgb2() '关闭程序，不能实现pdfFactory pro正常运行结束后关闭程序！
Dim datStartTime As Date
'通过列出系统全部进程，进行匹配
Set msoft = GetObject("winmgmts:").execquery("select * from win32_process where name like '%.exe'")
For Each s In msoft '用s.name可以列出所有运行的exe文件
If s.Name = "fppdis4.exe" Then
pid = s.processid
' s.Terminate'直接退出
'Exit Sub
End If
Next
hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, 0, pid)
'Dim hProcess As Long
'hProcess = OpenProcess(PROCESS_ALL_ACCESS, 0, pid) '打开进程
If hProcess Then ReadProcessMemory hProcess, ByVal &H12F82C, base, 4, 0& '读写进程内存
CloseHandle hProcess '关闭进程句柄
CloseHandle pid
AppActivate pid, 0
PostMessage hProcess, WM_CLOSE, 0, 0 '直接发送窗口信息也是不能关闭
PostMessage pid, WM_CLOSE, 0, 0
'Application.Quit'直接退出excel了
If hProcess <> 0 Then
datStartTime = Now
Do
If WaitForSingleObject(hProcess, 250) <> WAIT_TIMEOUT Then
Exit Do
End If
DoEvents
If max_wait_seconds > 0 Then
If DateDiff("s", datStartTime, Now) > max_wait_seconds Then Exit Do
End If
Loop
CloseHandle hProcess '两种方式都试试
CloseHandle pid
End If
MsgBox "RUN END."
'Shell "taskkill /im SerialScan.exe" '这个是直接杀进程，也可以关闭
End Sub
Sub smgb() '关闭程序，这个也是直接关
'通过列出系统全部进程，进行匹配
Set msoft = GetObject("winmgmts:").execquery("select * from win32_process where name like '%.exe'")
For Each s In msoft '用s.name可以列出所有运行的exe文件
If s.Name = "fppdis4.exe" Then
pid = s.processid
' s.Terminate'直接退出
'Exit Sub
End If
Next
hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, 0, pid)
isDone = False
Do '一直卡在这里，状态码一直为259 ,实际未完全运行结束状态码还是259，这里实际有问题！！！！无法在pdfFactory pro正常运行结束后关闭程序！
'通过处理器拿到进程状态码
Call GetExitCodeProcess(hProcess, ExitCode)
Debug.Print ExitCode
DoEvents
'如果状态码一直是运行中(259)，则一直循环
Loop While ExitCode = STILL_ALIVE
CloseHandle hProcess '两种方式都试试
CloseHandle pid
's.Terminate
MsgBox "RUN END."
End Sub
|
|
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2022-8-9 09:29
楼主
