![[upsidedown]](/data/assets/smilies/upsidedown.gif "[upsidedown] [upsidedown]")
Option Explicit
' These APIs are used to run Acrobat/Reader from withing VB.
' Apparently, they get registry entries ...
Private Declare Function RegOpenKeyEx Lib "advapi32" Alias "RegOpenKeyExA" _
(ByVal hKey As Long, ByVal lpSubKey As String, _
ByVal dwReserved As Long, ByVal samDesired As Long, _
phkResult As Long) As Long
Private Declare Function RegQueryValueEx Lib "advapi32" Alias "RegQueryValueExA" _
(ByVal hKey As Long, ByVal lpValueName As String, _
ByVal lpdwReserved As Long, lpdwType As Long, lpData As Any, _
lpcbData As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32" _
(ByVal hKey As Long) As Long
Const HKEY_LOCAL_MACHINE As Long = &H80000002
Private Function fncGetRegString _
(hInKey As Long, ByVal subkey As String, ByVal valname As String) As String
Dim RetVal As String
Dim hSubKey As Long
Dim dwType As Long
Dim SZ As Long
Dim R As Long
Dim v As String
Const KEY_ALL_ACCESS As Long = &H3F
Const ERROR_SUCCESS As Long = 0
Const REG_SZ As Long = 1
RetVal = ""
R = RegOpenKeyEx(hInKey, subkey, 0, KEY_ALL_ACCESS, hSubKey)
If R <> ERROR_SUCCESS Then
GoTo Quit_Now
End If
SZ = 256
v = String(SZ, 0)
R = RegQueryValueEx(hSubKey, valname, 0, dwType, ByVal v, SZ)
If R = ERROR_SUCCESS And dwType = REG_SZ Then
SZ = SZ - 1
RetVal = Left(v, SZ)
Else
RetVal = "-- Not String --"
End If
If hInKey = 0 Then
R = RegCloseKey(hSubKey)
End If
Quit_Now:
fncGetRegString = RetVal
End Function
Public Function fncAcrobatViewer() As String
Dim strViewer As String
Dim intpos As Integer
strViewer = fncGetRegString(HKEY_LOCAL_MACHINE, _
"SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\Acrobat.exe", _
"Path")
' Uses Acrobat if installed ...
If strViewer <> "" Then
strViewer = strViewer + "\Acrobat.exe"
Else
' Acrobat is not installed
strViewer = fncGetRegString(HKEY_LOCAL_MACHINE, _
"SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\AcroRd32.exe", _
"Path")
' The function as included in the Acrobat Developer FAQ fails to account for the fact that
' the "Path" for "AcroRd32.exe" includes a SECOND path, separated from the first by a
' semi-colon, i.e., it is intended to be a DOS-style path. The first part of the path is,
' fortunately, what we're after, so all we need to do is split off the bit before the
' semi-colon. Since it seems virtually impossible to contact Adobe directly to tell them
' this, other programmers will have to suffer and find out for themselves.
intpos = InStr(1, strViewer, ";")
If intpos = 0 Then
strViewer = strViewer & "\AcroRd32.exe"
Else
strViewer = Left(strViewer, intpos - 1) & "\AcroRd32.exe"
End If
End If
fncAcrobatViewer = strViewer
End Function
Public Function fncAcrobatDistiller() As String
fncAcrobatDistiller = _
fncGetRegString(HKEY_LOCAL_MACHINE, _
"SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\AcroDist.exe", _
"Path") & _
"\AcroDist.exe"
End Function
Public Function fncDistillerOptionsPath() As String
Dim strAcrobatPath As String
strAcrobatPath = fncAcrobatViewer
fncDistillerOptionsPath = _
Left(strAcrobatPath, InStrRev(strAcrobatPath, "\")) & _
"\Distillr\Settings"
End Function
Public Function fncOutlook() As String
fncOutlook = fncGetRegString(HKEY_LOCAL_MACHINE, _
"SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\OUTLOOK.EXE", _
"Path") & _
"\Outlook.exe"
End FunctionDim strPath As String
strPath = fncOutlookOption Explicit
' Structures declaration
Private Type STARTUPINFO
cb As Long
lpReserved As String
lpDesktop As String
lpTitle As String
dwX As Long
dwY As Long
dwXSize As Long
dwYSize As Long
dwXCountChars As Long
dwYCountChars As Long
dwFillAttribute As Long
dwFlags As Long
wShowWindow As Integer
cbReserved2 As Integer
lpReserved2 As Long
hStdInput As Long
hStdOutput As Long
hStdError As Long
End Type
Private Type PROCESS_INFORMATION
hProcess As Long
hThread As Long
dwProcessID As Long
dwThreadID As Long
End Type
' Function declaration
Private Declare Function WaitForSingleObject Lib "kernel32.dll" _
(ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Private Declare Function CloseHandle Lib "kernel32.dll" _
(ByVal hObject As Long) As Long
Private Declare Function CreateProcessA Lib "kernel32.dll" _
(ByVal lpApplicationName As Long, ByVal lpCommandLine As String, _
ByVal lpProcessAttributes As Long, ByVal lpThreadAttributes As Long, _
ByVal bInheritHandles As Long, _
ByVal dwCreationFlags As Long, ByVal lpEnvironment As Long, _
ByVal lpCurrentDirectory As Long, lpStartupInfo As STARTUPINFO, _
lpProcessInformation As PROCESS_INFORMATION) As Long
'Constants
Private Const NORMAL_PRIORITY_CLASS = &H20&
Private Const INFINITE = -1&
Public Function ExecuteTask(pPath As String, Optional pParameters As String = "") As Long
Dim proc As PROCESS_INFORMATION
Dim startup As STARTUPINFO
Dim lngRet As Long
Dim strCmdLine As String
strCmdLine = pPath
If Trim(pParameters) <> "" Then
strCmdLine = strCmdLine & " """ & pParameters & """"
End If
' Initialize the STARTUPINFO structure:
startup.cb = Len(startup)
' Start the application:
lngRet = CreateProcessA _
(0&, strCmdLine, 0&, 0&, 1&, NORMAL_PRIORITY_CLASS, 0&, 0&, startup, proc)
ExecuteTask = proc.hProcess
End FunctionDim lngTaskID As Long
lngTaskID = ExecuteTask(fncOutlook)
