LinkBack Thread Tools Search this Thread Display Modes
Prev Previous Post   Next Post Next
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 114
Default 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

 
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
When i open excel file it takes time to open Muraliraj Menon Excel Discussion (Misc queries) 1 May 23rd 07 12:50 PM
excel 2003 saved file will not open without a blank workbook open Bob Excel Discussion (Misc queries) 4 November 11th 06 04:24 PM
In Excel - Use Windows Explorer instead of File Open to open file KymY Excel Discussion (Misc queries) 1 August 5th 06 09:59 PM
Open email windows can't open, excel shreadsheet file .xls ? skiz Excel Discussion (Misc queries) 0 October 2nd 05 07:03 PM
How do I stop Excel from closing the open file each time I open a. Welsin Setting up and Configuration of Excel 3 January 8th 05 11:16 PM


All times are GMT +1. The time now is 04:04 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
Copyright ©2004-2025 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"