Excel Forum - Porady, Pomoc, Excel Help, Excel FAQ - Adobe Excel czeka na OLE Adobe

Auditorius · Wysłany: 05-04-2021, 11:33 **Adobe Excel czeka na OLE Adobe**

Dzień Dobry,

Mam funkcję do wyszukiwania słów w PDFach z pomoca pełnej wersji Acrobata

Kod:

Option Explicit

Function Znajdz1słowowPDFie(PDF_Path As String, Word_To_Find As String) As String

'----------------------------------------------------------------------------------------
'This macro can be used to find a specific WORD in a PDF document (one word ONLY -> in
'case you search two words for example it doesn't find anything, just opens the file).
'The macro opens the PDF, finds the first appearance of the specified word, scrolls
'so that it is visible and highlights it.

'The code uses late binding, so no reference to external library is required.
'However, the code works ONLY with Adobe Professional, so don't try to use it with
'Adobe Reader because you will get an "ActiveX component can't create object" error.

'Written by: Christos Samaras
'Date: 04/05/2014
'e-mail: 'xristos.samaras@gmail.com'
'site: 'http://www.myengineeringworld.net'
' Change into Function Auditorius 2021
'--------------------------------------------------------------------------------------

' Speed On
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.AskToUpdateLinks = False
Application.DisplayAlerts = False
Application.Calculation = xlAutomatic
ThisWorkbook.Date1904 = False
ActiveWindow.View = xlNormalView

'Declaring the necessary variables.
Dim App As Object
Dim AVDoc As Object
Dim PDDoc As Object
Dim JSO As Object
Dim i As Long
Dim j As Long
Dim Word As Variant
Dim Result As Integer

'Specify the text you want to search.
'Word_To_Find = "Engineering"
'Using a range:
'Word_To_Find = ThisWorkbook.Sheets("PDF Search").Range("C12").Value

'Specify the path of the sample PDF form.
'Full path example:
'PDF_Path = "C:\Users\Christos\Desktop\How Software Companies Die.pdf"
'Using workbook path:
'PDF_Path = ThisWorkbook.Path & "\" & "How Software Companies Die.pdf"
'Using a range:
'PDF_Path = ThisWorkbook.Sheets("PDF Search").Range("C14").Value

'Check if the file exists.
If Dir(PDF_Path) = "" Then
Znajdz1słowowPDFie = "Nie mogę odnaleźć pliku PDF! Sprawdź ścieżkę pliku i spróbuj ponownie"
Exit Function
End If

'Check if the input file is a PDF file.
If LCase(Right(PDF_Path, 3)) <> "pdf" Then
Znajdz1słowowPDFie = "Plik wejściowy to nie plik PDF !"
Exit Function
End If

'Initialize Acrobat by creating the App object.
Set App = CreateObject("AcroExch.App")

'Check if the object was created. In case of error release the objects and exit.
If err.Number <> 0 Then
Znajdz1słowowPDFie = "Nie moge utworzyć obiektu Adobe Application!"
Set App = Nothing
Exit Function
End If

'Create the AVDoc object.
Set AVDoc = CreateObject("AcroExch.AVDoc")

'Check if the object was created. In case of error release the objects and exit.
If err.Number <> 0 Then
Znajdz1słowowPDFie = "Nie moge utworzyć obiektu AVDoc"
Set AVDoc = Nothing
Set App = Nothing
Exit Function
End If

'Open the PDF file.

'If AVDoc.Open(PDF_Path, "") <> True Then
' Znajdz1słowowPDFie = "Nie moge otworzyć pliku PDF !"
' Set AVDoc = Nothing
' Set App = Nothing
'Exit Function
'End If

If AVDoc.Open(PDF_Path, "") = True Then

'Open successful, bring the PDF document to the front.
' AVDoc.BringToFront

'Set the PDDoc object.
Set PDDoc = AVDoc.GetPDDoc

'Set the JS Object - Java Script Object.
Set JSO = PDDoc.GetJSObject

'Search for the word.
If Not JSO Is Nothing Then

'Loop through all the pages of the PDF.
For i = 0 To JSO.numPages - 1

'Loop through all the words of each page.
For j = 0 To JSO.getPageNumWords(i) - 1

'Get a single word.
Word = JSO.getPageNthWord(i, j)

'If the word is string...
If VarType(Word) = vbString Then

'Compare the word with the text to be found.
Result = StrComp(Word, Word_To_Find, vbTextCompare)

'If both strings are the same.
If Result = 0 Then
'Select the word and exit.
Znajdz1słowowPDFie = "Znalazłem szukane 1 słowo !"
' Call JSO.selectPageNthWord(i, j)
Exit Function
End If

End If

Next j

Next i

'Word was not found, close the PDF file without saving the changes.
AVDoc.Close True

'Close the Acrobat application.
App.Exit

'Release the objects.
Set JSO = Nothing
Set PDDoc = Nothing
Set AVDoc = Nothing
Set App = Nothing

'Inform the user.
Znajdz1słowowPDFie = "Słowa '" & Word_To_Find & "' nie ma w pliku PDF!"
Exit Function
End If

Else

'Unable to open the PDF file, close the Acrobat application.
App.Exit

'Release the objects.
Set AVDoc = Nothing
Set App = Nothing

'Inform the user.
Znajdz1słowowPDFie = "Nie mogę otworzyć pliku PDF!"
Exit Function
End If

' Speed OFF
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.AskToUpdateLinks = True
Application.DisplayAlerts = True
Application.Calculation = xlAutomatic
ThisWorkbook.Date1904 = False
Application.StatusBar = False

End Function

Mam też kod od obsługi sytuacji 'Excel czeka na zakończenie działania OLE"
W moim przypadku chodzi o sytuację kiedy pliki PDF jest uszkodzony i nie da się go otworzyć w Adobe. W takim przypadku chciałbym albo:
- wygenerować wartość funkcji jako 'błąd w pliku PDF" i zakończyć
- albo kliknąć 'OK"

Znalazłem taki kod

Kod:

Private Declare Function CoRegisterMessageFilter Lib "ole32" (ByVal IFilterIn As Long, ByRef PreviousFilter) As Long

Public Sub KillMessageFilter()

Dim IMsgFilter As Long

CoRegisterMessageFilter 0&, IMsgFilter

End Sub

I analogiczny kawałek

Kod:

https://groups.google.com/g/microsoft.public.excel.programming/c/ct8NRT-o7rs/m/jawi42S8Ci0J?pli=1
'You can solve this by using the COM API to remove VBA's message filter.
'This will prevent COM from telling VBA to displaying a message box when it
'thinks the process you're calling has blocked. Note that if the process
'really has blocked for some reason this will prevent you from receiving any
'notification of that.

Private Declare Function _
CoRegisterMessageFilter Lib "OLE32.DLL" _
(ByVal lFilterIn As Long, _
ByRef lPreviousFilter) As Long

Function KillMessageFilter()

Dim lMsgFilter As Long

' Remove the message filter before calling Reflections.
CoRegisterMessageFilter 0&, lMsgFilter

''' Call Reflections here....

''' Restore the message filter after calling Reflections.
' I am calling it off
CoRegisterMessageFilter lMsgFilter, lMsgFilter

End Function

'Rob Bovey, MCSE, MCSD, Excel MVP
'Application Professionals
'http://www.appspro.com/

Ale nie wiem jak go połączyć z funkcją wyszukiwania słowa w Adobe - jak 'zagniezdzam' jedną funkcję w drugiej to non stop wyskakują różne błedy.
Analogicznie jak 2gą funkcję przesunąlem 'na koniec' i probuję wywołać to Call
to występują inne błędy

Czy da się 'po prostu' kliknąć guzik OK ?