Open a pdf file from Excel VB
 

Hi Luc

If your file is to be used on different machines, the following code
looks up the Windows Registry for the installation of Acrobat, so will
launch different versions. The code includes slight modifications by
myself, but is derived from code by Elliot Spencer
).

First you place this code in a module:

' Registry value type definitions
Public Const REG_BINARY As Long = 3
Public Const REG_DWORD As Long = 4

' Registry section definitions
Public Const HKEY_CLASSES_ROOT = &H80000000

' Registry API functions used in this module
Private Declare Function RegOpenKey Lib "advapi32.dll" Alias
"RegOpenKeyA" _
(ByVal hKey As Long, ByVal lpSubKey As String, phkResult As
Long) As Long
Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias
"RegQueryValueExA" _
(ByVal hKey As Long, ByVal lpValueName As String, ByVal
lpReserved As Long, lpType As Long, ByVal lpData As String, lpcbData As
Long) As Long
Private Declare Function RegCloseKey Lib "advapi32.dll" _
(ByVal hKey As Long) As Long

' Created by E.Spencer ) - This code is public
domain.
' This routine allows you to get values from anywhere in the Registry,
it currently only
' handles string, double word and binary values. Binary values are
returned as strings.
'
' Example:
' Text1.Text = ReadRegistry(HKEY_LOCAL_MACHINE,
"SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon\",
"DefaultUserName")
'
Public Function ReadRegistry(ByVal Group As Long, _
ByVal Section As String, _
ByVal Key As String) As String
Dim lResult As Long
Dim lKeyValue As Long
Dim lDataTypeValue As Long
Dim lValueLength As Long
Dim sValue As String
Dim td As Double
Dim TStr1 As String
Dim TStr2 As String
Dim i As Integer

On Error Resume Next

lResult = RegOpenKey(Group, Section, lKeyValue)
sValue = Space(2048)
lValueLength = Len(sValue)
lResult = RegQueryValueEx(lKeyValue, Key, 0&, lDataTypeValue,
sValue, lValueLength)

If (lResult = 0) And (Err.Number = 0) Then
If lDataTypeValue = REG_DWORD Then
td = Asc(Mid(sValue, 1, 1)) + &H100& * Asc(Mid(sValue, 2, 1))
+ _
&H10000 * Asc(Mid(sValue, 3, 1)) + &H1000000 *
CDbl(Asc(Mid(sValue, 4, 1)))
sValue = Format(td, "000")
End If

If lDataTypeValue = REG_BINARY Then
' Return a binary field as a hex string (2 chars per byte)
TStr2 = ""
For i = 1 To lValueLength
TStr1 = Hex(Asc(Mid(sValue, i, 1)))
If Len(TStr1) = 1 Then TStr1 = "0" & TStr1
TStr2 = TStr2 + TStr1
Next
sValue = TStr2
Else
sValue = Left(sValue, lValueLength - 1)
End If
Else
sValue = "Not Found"
End If

lResult = RegCloseKey(lKeyValue)
ReadRegistry = sValue
End Function
___________________________________

Next, you'll need a function that utilises this API. I have a macro
that is passed a file name, so that I can open several PDFs:

Private Function LaunchAcrobat(ByVal sPDFNameA As String) As Integer

Dim sFilePath As String
Dim sExePathFilePath As String
Dim sExePath As String
Dim RegistryLocation As String
Dim sMsg As String

sFilePath = ThisWorkbook.Path & "\" & sPDFNameA

' Return error message and exit if file can't be found
If Dir(sFilePath) = "" Then
sMsg = sPDFNameA & " must be located in same directory as this
file" & vbCrLf & _
"(" & ThisWorkbook.Path & ")"
MsgBox sMsg, vbInformation, TITLE
Exit Function
End If

' Proceed if file found
On Error GoTo Acrobat_Error
RegistryLocation = "AcroExch.Document\Shell\Open\command"

' Get directory location of Acrobat EXE file
sExePath = ReadRegistry(HKEY_CLASSES_ROOT, RegistryLocation, "")

' Build string of instal path and file path, eg, C:\Acrobat.exe
"C:\Test.pdf"
sExePathFilePath = Mid(sExePath, 2, Len(sExePath) - 7) & " " &
Chr(34) & _

sFilePath & Chr(34)
' Launch Acrobat and required file
Shell sExePathFilePath, vbMaximizedFocus

Acrobat_Error:
MsgBox "Run Acrobat Error: " & Err.Number & " " & Err.Description,
vbCritical

End Function
_______________________________

Lastly, I have a macro that calls the function with the name of the
file to be opened:

Public Sub LaunchHelp()
LaunchAcrobat "Help.pdf"
End Sub


Regards

Paul Martin
Melbourne, Australia