Declare PtrSafe Function SendMessageA Lib "user32" (ByVal hwnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, lParam As Any) As LongPtr
Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
Private Declare PtrSafe Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As LongPtr, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare PtrSafe Function GetWindow Lib "user32" (ByVal hwnd As LongPtr, ByVal wCmd As Long) As Long
Declare PtrSafe Function ShowWindow Lib "user32" (ByVal hwnd As LongPtr, ByVal nCmdShow As Long) As Long
Const WM_CLOSE = &H10
Sub testpdf2()
Dim x As LongPtr, t$
Set clip = CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
clip.SetText "": clip.PutInClipboard
t = ""
With CreateObject("wscript.shell")
.Run "C:\Users\patricktoulon\Desktop\FEM_K1801.pdf", vbMaximizedFocus
Do While i < 1000: DoEvents: i = i + 1: Loop
x = FindWindoWByPartTitle("*FEM_K1801.pdf")
DoEvents
ShowWindow x, 3
Do While Len(t) < 1000
.SendKeys "^a"
.SendKeys "^c"
DoEvents
clip.GetFromClipboard
t = clip.GetText(1)
DoEvents
Loop
End With
If x <> 0 Then SendMessageA x, WM_CLOSE, 0, 0
[a1].Select
ActiveSheet.Paste
MsgBox x
End Sub
Function FindWindoWByPartTitle(Optional partTittle As String, Optional PartApp As String)
Dim sStr As String, hwnd As LongPtr
sStr = Space$(150)
hwnd = FindWindow(vbNullString, vbNullString)
Do While hwnd <> 0
GetWindowText hwnd, sStr, 300
If sStr Like "*" & partTittle & "*" Then
FindWindoWByPartTitle = hwnd
Exit Function
End If
hwnd = GetWindow(hwnd, 2)
Loop
End Function