Hi all,

My application wants to know whether the target computer has installed
"Acrobat Reader" or not and to get the "InstallPath" information before it
calls the AcroRD32.exe to open a PDF file from my application.

Thanks in advance!

KS

Hello KS,

As you can see from the code provided, this is a non trivial procedure.
The code has error handling builtin to alert you if there is a problem.
Insert a new VBA module into your project and paste the code into it.

CALLING THE MACRO:

InstallPath = GetAcrobatPath()



Code:
--------------------

'----------------------------------------------'
' REGISTRY HKEY CONSTANTS '
'----------------------------------------------'

Public Const HKCR As Long = &H80000000 'Key Handle for HKEY_CLASSES_ROOT
Public Const HKCU As Long = &H80000001 'Key Handle for HKEY_CURRENT_USER
Public Const HKLM As Long = &H80000002 'Key Handle for HKEY_LOCAL_MACHINE
Public Const HKU As Long = &H80000003 'Key Handle for HKEY_USERS
Public Const HKPD As Long = &H80000004 'Key Handle for HKEY_PERFORMANCE_DATA (Windows NT)
Public Const HKCC As Long = &H80000005 'Key Handle for HKEY_CURRENT_CONFIG
Public Const HKDD As Long = &H80000006 'Key Handle for HKEY_DYN_DATA (Windows '95, '98)

'----------------------------------------------'
' REGISTRY OPTION CONSTANTS '
'----------------------------------------------'
Private Const REG_OPTION_NON_VOLATILE As Long = &H0&
Private Const REG_OPTION_VOLATILE As Long = &H1& ' Ignored by Windows '95, '98, and ME
Private Const REG_OPTION_BACKUP_RESTORE As Long = &H4& ' Not supported by Windows '95, '98, or ME

'----------------------------------------------'
' REGISTRY SECURITY AND ACCESS MASK CONSTANTS '
'----------------------------------------------'

Private Const NO_ERROR As Long = 0&
Private Const KEY_QUERY_VALUE As Long = &H1&
Private Const KEY_SET_VALUE As Long = &H2&
Private Const KEY_CREATE_SUB_KEY As Long = &H4&
Private Const KEY_ENUMERATE_SUB_KEYS As Long = &H8
Private Const KEY_NOTIFY As Long = &H10&
Private Const KEY_CREATE_LINK As Long = &H20&
Private Const SYNCHRONIZE As Long = &H100000
Private Const STANDARD_RIGHTS_READ As Long = &H20000
Private Const KEY_WOW64_64KEY As Long = &H100&
Private Const KEY_WOW64_32KEY As Long = &H200&

Private Const KEY_READ As Long = ((STANDARD_RIGHTS_READ Or _
KEY_QUERY_VALUE Or _
KEY_ENUMERATE_SUB_KEYS Or _
KEY_NOTIFY) And _
(Not SYNCHRONIZE))
Private Const KEY_WRITE As Long = (STANDARD_RIGHTS_READ Or _
KEY_SET_VALUE Or _
KEY_CREATE_SUB_KEY)
Private Const KEY_ALL_ACCESS As Long = (STANDARD_RIGHTS_READ Or _
KEY_QUERY_VALUE Or _
KEY_SET_VALUE Or _
KEY_CREATE_SUB_KEY Or _
KEY_ENUMERATE_SUB_KEYS Or _
KEY_NOTIFY Or _
KEY_CREATE_LINK)

'----------------------------------------------'
' API ERROR MESSAGE FORMAT CONSTANTS '
'----------------------------------------------'

Private Const FORMAT_MESSAGE_FROM_SYSTEM As Long = &H1000&
Private Const FORMAT_MESSAGE_IGNORE_INSERTS As Long = &H200&

'----------------------------------------------'
' API ERROR MESSAGE HANDLER '
'----------------------------------------------'

Private Declare Function FormatMessage _
Lib "Kernel32.dll" _
Alias "FormatMessageA" _
(ByVal dwFlags As Long, _
ByRef lpSource As Any, _
ByVal dwMessageId As Long, _
ByVal dwLanguageId As Long, _
ByVal lpBuffer As String, _
ByVal nSize As Long, _
ByRef Arguments As Long) As Long

'----------------------------------------------'
' REGISTRY API FUNCTIONS '
'----------------------------------------------'

Private Declare Function RegOpenKeyEx _
Lib "advapi32.dll" _
Alias "RegOpenKeyExA" _
(ByVal hKey As Long, _
ByVal lpSubKey As String, _
ByVal ulOptions As Long, _
ByVal samDesired As Long, _
ByRef 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, _
ByRef lpType As Long, _
ByRef lpData As Any, _
ByRef lpcbData As Long) As Long

Private Declare Function lstrlenW _
Lib "Kernel32.dll" _
(ByVal lpString As Long) As Long

Private Declare Sub CopyMemory _
Lib "Kernel32.dll" _
Alias "RtlMoveMemory" _
(ByRef lpvDest As Any, _
ByRef lpvSource As Any, _
ByVal cbCopy As Long)

Public Function OpenRegKey(ByVal hKey As Long, ByVal lpSubKey As String) As Long

'Returns a handle to the Subkey if successful
'hKey is one of the HKEY constants: HKCR, HKCU, HKLM, etc.
'SubKey is a path: "Control Panel\Colors"

Dim hSubKey As Long
Dim Result

Result = RegOpenKeyEx(hKey, lpSubKey, REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, hSubKey)

If Result = NO_ERROR Then
OpenRegKey = hSubKey
Else
MsgBox GetAPIError(Result), vbCritical + vbOKOnly, "Registry Ops - OpenRegKey"
End If

End Function

Public Function ReadRegEntry(ByRef hSubKey As Long, ByRef sKeyName As String) As Variant

'OpenRegKey supplies the handle to Subkey
'sKeyName is the name of an item within the Subkey
'Using the example in OpenRegKey, sKeyName could be "ButtonFace"
'The return value would be a string like "212 208 200"
'The return value will either be a number or a string

Dim BuffSize As Long
Dim ByteArray() As Byte
Dim ByteString As String
Dim I As Long
Dim KeyType As Long
Dim lpcbBytes As Long 'Length of the retrieved value
Dim lpDWord As Long
Dim lpMultiString As String
Dim lpString As String 'Name of the value to retrieve
Dim Result
Dim StrIndex As Long
Dim TempStr As String

BuffSize = 2048&
ReDim ByteArray(BuffSize)

'Is there a SubKey Present
If hSubKey < 0 Then

'Setup the Buffers for the Value
lpString = Space$(BuffSize)
lpcbBytes = BuffSize

'Get the SubKey's Value and Store it in ByteArray
Result = RegQueryValueEx(hSubKey, sKeyName, 0&, KeyType, ByteArray(0), lpcbBytes)

If Result = NO_ERROR Then

Select Case KeyType
Case 1, 2
CopyMemory ByVal lpString, ByteArray(0), lpcbBytes
ReadRegEntry = Left(lpString, lstrlenW(StrPtr(lpString)))
Case 3
For I = 0 To lpcbBytes - 1
ByteString = ByteString & Format(Hex(ByteArray(I)), "00") & " "
Next I
ReadRegEntry = ByteString
Case 4
CopyMemory lpDWord, ByteArray(0), lpcbBytes
ReadRegEntry = lpDWord
Case 7
CopyMemory ByVal lpMultiString, ByteArray(0), lpcbBytes
Do
StrIndex = lstrlenW(StrPtr(lpMultiString))
If StrIndex = 0 Then
Exit Do
Else
TempStr = TempStr & Left(lpMultiString, StrIndex - 1) & ", "
End If
Loop
ReadRegEntry = Left(TempStr, Len(TempStr) - 2)
Case Else
ReadRegEntry = ""
End Select

Else
ReadRegEntry = ""
MsgBox GetAPIError(Result), vbCritical + vbOKOnly, "Registry Ops - ReadRegEntry"
End If

End If

End Function

Public Function GetAPIError(ByVal ErrorNumber As Long) As String

Dim Args As Long
Dim Buff As String
Dim cch As Long

'Return the Error Message
Buff = String$(256, 0)
cch = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM Or FORMAT_MESSAGE_IGNORE_INSERTS, _
0&, ErrorNumber, 0&, Buff, Len(Buff), Args)
If cch < 0 Then
GetAPIError = Left$(Buff, cch)
End If

End Function

Public Function GetAcrobatPath() As String

Dim I As Long
Dim hSubKey As Long
Dim InstallPath As String

hSubKey = OpenRegKey(HKCR, "AcroExch.Document\shell\Open\command")
InstallPath = ReadRegEntry(hSubKey, "")

'Look for double quote, space, double quote
I = InStr(1, InstallPath, Chr$(34) & Chr$(32) & Chr$(34))

'Calculate the length less any switches
If I 0 Then
I = Len(InstallPath) - (Len(InstallPath) - I)
Else
I = Len(InstallPath)
End If

'Remove the double quotes from around the path
GetAcrobatPath = Mid(InstallPath, 2, I - 2)

End Function

--------------------


Sincerely,
Leith Ross


--
Leith Ross
------------------------------------------------------------------------
Leith Ross's Profile: http://www.excelforum.com/member.php...o&userid=18465
View this thread: http://www.excelforum.com/showthread...hreadid=492543