Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassname As String, ByVal lpWindowName As String) As LongPtr
Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As LongPtr, ByVal wMsg As Long, ByVal wParam As Long, lParam As Long) As Long
'
Private Const WM_CLOSE As Integer = &H10
'-----------------------------------------
'Open a PDF and copy the text in the sheet
'-----------------------------------------
Function GetPDFTextViaExcel(FichierPDF As String) As String
Dim ChromeExe As String
Dim NomPDF As String
Dim hWnd As LongPtr
'
Const Chrome64 = "C:\Program Files\Google\Chrome\Application\chrome.exe"
Const Chrome32 = "C:\Program Files (x86)\Google\Chrome\Application\chrome.exe"
If Len(Dir(Chrome64)) > 0 Then
ChromeExe = Chrome64
ElseIf Len(Dir(Chrome32)) > 0 Then
ChromeExe = Chrome32
Else
MsgBox "Chrome.exe non trouvé !"
Exit Function
End If
'PDF file name
NomPDF = Mid(FichierPDF, InStrRev(FichierPDF, "\") + 1)
'Kill possible existing window
Do While 1
hWnd = FindWindow(vbNullString, NomPDF & " - Google Chrome")
If Not hWnd = 0 Then
Call SendMessage(hWnd, WM_CLOSE, 0, 0)
Else
Exit Do
End If
Loop
'Run Chrome and wait for the Window to be ready
Call Shell(ChromeExe & " --new-window -url " & """" & FichierPDF & """", vbNormalFocus)
Do While FindWindow(vbNullString, NomPDF & " - Google Chrome") = 0
Temporisation 100
Loop
'Send keys to Select All / Copy / Kill the application
CreateObject("wscript.shell").SendKeys "^a"
Temporisation 100
CreateObject("wscript.shell").SendKeys "{TAB}"
Temporisation 100
CreateObject("wscript.shell").SendKeys "^c"
Temporisation 100
CreateObject("wscript.shell").SendKeys "%{F4}"
Temporisation 10000
With ThisWorkbook.Worksheets(1)
.[A1].Select
.[A1].ClearContents
On Error Resume Next
.Paste
On Error GoTo 0
Temporisation 100
Application.ScreenUpdating = True
GetPDFTextViaExcel = .[A1].Value
End With
End Function
'-------------
'Temporisation
'-------------
Private Sub Temporisation(NbDoEvents As Integer)
Dim k As Integer
For k = 1 To NbDoEvents
DoEvents
Next k
End Sub
