VBA reading PDF not working

[jec]

Hi
Below vba worked a treat but now it freezes - think it may be splash screen in Adobe 10 and throws an error VBA (see yellow text below) and Adobe splashscreen is showing - is this fixable? Thank you.

Sub PDFDemo1()
Dim strPDF As String, strTmp As String, i As Integer
' The next ten lines and the last line in this sub can help if
' you get "ActiveX component can't create object" errors even
' though a Reference to Acrobat is set in Tools|References.
Dim bTask As Boolean
bTask = True
If Tasks.Exists(Name:="Adobe Acrobat Professional") = False Then
bTask = False
Dim AdobePath As String, WshShell As Object
Set WshShell = CreateObject("Wscript.shell")
AdobePath = WshShell.RegRead("HKEY_CLASSES_ROOT\acrobat\shell\open\command\")
AdobePath = Trim(Left(AdobePath, InStr(AdobePath, "/") - 1))
Shell AdobePath, vbHide
End If
'Replace FilePath & Filename with the correct FilePath & Filename for the pdf file to be read.
strPDF = ReadAcrobatDocument("Z:\eBOOKS\Microsoft Word 2007 to 2010.pdf")
ActiveDocument.Range.InsertAfter strPDF
If bTask = False Then Tasks.Item("Adobe Acrobat Professional").Close
End Sub



Public Function ReadAcrobatDocument(strFileName As String) As String
'Note: A Reference to the Adobe Library must be set in Tools|References!
Dim AcroApp As CAcroApp, AcroAVDoc As CAcroAVDoc, AcroPDDoc As CAcroPDDoc
Dim AcroHiliteList As CAcroHiliteList, AcroTextSelect As CAcroPDTextSelect
Dim PageNumber, PageContent, Content, i, j
Set AcroApp = CreateObject("AcroExch.App")
Set AcroAVDoc = CreateObject("AcroExch.AVDoc")
If AcroAVDoc.Open(strFileName, vbNull) <> True Then Exit Function
' The following While-Wend loop shouldn't be necessary but timing issues may occur.
While AcroAVDoc Is Nothing
Set AcroAVDoc = AcroApp.GetActiveDoc
Wend
Set AcroPDDoc = AcroAVDoc.GetPDDoc
For i = 0 To AcroPDDoc.GetNumPages - 1
Set PageNumber = AcroPDDoc.AcquirePage(i)
Set PageContent = CreateObject("AcroExch.HiliteList")
If PageContent.Add(0, 9000) <> True Then Exit Function
Set AcroTextSelect = PageNumber.CreatePageHilite(PageContent)
' The next line is needed to avoid errors with protected PDFs that can't be read
On Error Resume Next
For j = 0 To AcroTextSelect.GetNumText - 1
Content = Content & AcroTextSelect.GetText(j)
Next j
Next i
ReadAcrobatDocument = Content
AcroAVDoc.Close True
AcroApp.Exit
Set AcroAVDoc = Nothing: Set AcroApp = Nothing
End Function

[HansV]

Welcome to Eileen's Lounge!

I don't understand why you need the code involving Tasks. The function ReadAcrobatDocument starts and quits Adobe Acrobat, so you shouldn't try to do that too in the macro PDFDemo1 that calls it.

[jec]

Becuase that is the original code that worked. The code now stops at the splashscreen in Adobe 10.

[HansV]

I can't explain why the behavior changed. What happens if you leave the function as it is, and change the macro to

Code: Select all

Sub PDFDemo1()
    Dim strPDF As String
    strPDF = ReadAcrobatDocument("Z:\eBOOKS\Microsoft Word 2007 to 2010.pdf")
    ActiveDocument.Range.InsertAfter strPDF
End Sub

If the problem persists, we'll have to look for something else.

[jec]

The original works on one machine same set up but not the other. Thank you Hans.
The short version you posted above also works.
Thanks you.

[dcruzer]

I want to thank HansV for the solution he provided. In case there are others out there who need to read PDF from VBA and don't know Acrobat, I'm posting this alternative method. This method depends on having a copy of pdftotext.exe which is easy to find. My environment is Windows Vista 64, Outlook 2003, but this solution also works in Windows 7 with Outlook 2007.

Public Const PDFoutfile As String = "C:\temp\out.txt"

Function ExtractContentsFromPDF(filen As String) As String
Dim CommandLineStr As String
Dim TheFileNameThatWasFound As String
Dim b As Boolean

TheFileNameThatWasFound = Dir(PDFoutfile)
'MsgBox "The file name found was : " & TheFileNameThatWasFound
If TheFileNameThatWasFound <> "" Then Kill PDFoutfile
CommandLineStr = "C:\Users\Public\Public Tools\pdftotext.exe " & filen & " " & PDFoutfile
b = Shell(CommandLineStr, 0)
If b Then
ExtractContentsFromPDF = PDFoutfile
Else
ExtractContentsFromPDF = ""
End If
End Function

-d2