Option Explicit
'
' Constants
'
' ..............................................................................
' Private...
Private Const mlchInputKeyboard As Long = 1
Private Const mlchEventKeyDown As Long = &H0
Private Const mlchEventKeyUp As Long = &H2
'
' API
'
' ..............................................................................
Private Declare Sub apiCopyMemory Lib "kernel32" _
Alias "RtlMoveMemory" (pDst As Any, _
pSrc As Any, _
ByVal ByteLen As Long)
Private Declare Function apiEnumChildWindows Lib "user32" _
Alias "EnumChildWindows" (ByVal hWndParent As Long, _
ByVal lpEnumFunc As Long, _
ByVal lParam As Long) As Long
Private Declare Function apiFindWindowExtended 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 apiGetDesktopWindow Lib "user32" _
Alias "GetDesktopWindow" () As Long
Private Declare Function apiGetWindowText Lib "user32" _
Alias "GetWindowTextA" (ByVal hwnd As Long, _
ByVal lpString As String, _
ByVal cch As Long) As Long
Private Declare Function apiSendInput Lib "user32.dll" _
Alias "SendInput" (ByVal nInputs As Long, _
pInputs As apiInput, _
ByVal cbSize As Long) As Long
Private Declare Function apiSetForegroundWindow Lib "user32" _
Alias "SetForegroundWindow" (ByVal hwnd As Long) As Long
'
' Variables
'
' ..............................................................................
' Handle...
Private mlvhCreatorHandle As Long
' Title...
Private mlvhCreatorTitle As String
'
' Types
'
' ..............................................................................
Private Type apiInput
dwType As Long
xi(0 To 23) As Byte
End Type
Private Type apiInputKeyboard
wVk As Integer
wScan As Integer
dwFlags As Long
time As Long
dwExtraInfo As Long
End Type
'
' Private
'
' ..............................................................................
' Childs...
Private Function mlfhChild(ByVal Handle As Long, _
ByVal Params As Long) As Long
Dim b As Boolean
Dim t As String
Dim n As Long
Dim r As Long
' Errors...
On Error Resume Next
' Title..
t = String(255, " ")
r = apiGetWindowText(Handle, t, 255)
' Check...
If Len(t) > 0 Then
' Reset...
b = CBool(InStr(1, UCase(t), UCase("PDF Creator")) > 0) Or _
CBool(InStr(1, UCase(t), UCase("PDFCreator")) > 0)
' Check...
If b And mlvhCreatorHandle < 1 Then
mlvhCreatorHandle = Handle
mlvhCreatorTitle = t
End If
End If
' Return...
mlfhChild = True
End Function
Private Function mlfhChildEnumerator(Handle As Long) As Long
Dim r As Long
' Errors...
On Error Resume Next
' Reset...
mlvhCreatorHandle = 0
mlvhCreatorTitle = ""
' Enumerate...
apiEnumChildWindows Handle, AddressOf mlfhChild, 0
' Return...
mlfhChildEnumerator = mlvhCreatorHandle
End Function
'
' Public
'
' ..............................................................................
' Enumerate...
Public Function mlfpCreatorEnumerate() As Long
Dim r As Long
Dim t(0 To 3) As apiInput
Dim k(0 To 3) As apiInputKeyboard
' Errors...
On Error Resume Next
' Return...
r = mlfhChildEnumerator(apiGetDesktopWindow)
' Check....
If r > 0 Then
' Inputs...
k(0).wVk = vbKeyControl
k(1).wVk = vbKeyA
k(2).wVk = vbKeyA
k(3).wVk = vbKeyControl
k(0).dwFlags = mlchEventKeyDown
k(1).dwFlags = mlchEventKeyDown
k(2).dwFlags = mlchEventKeyUp
k(3).dwFlags = mlchEventKeyUp
t(0).dwType = mlchInputKeyboard
t(1).dwType = mlchInputKeyboard
t(2).dwType = mlchInputKeyboard
t(3).dwType = mlchInputKeyboard
' Copy...
apiCopyMemory t(0).xi(0), k(0), Len(k(0))
apiCopyMemory t(1).xi(0), k(1), Len(k(1))
apiCopyMemory t(2).xi(0), k(2), Len(k(2))
apiCopyMemory t(3).xi(0), k(3), Len(k(3))
' Activate...
apiSetForegroundWindow mlvhCreatorHandle
' Message...
apiSendInput 4, t(0), Len(t(0))
' Activate...
apiSetForegroundWindow Application.hwnd
End If
' Return...
mlfpCreatorEnumerate = r
End Function
'
' EOF
'
' ..............................................................................