Find path to outlook.exe

  • Thread starter Thread starter Hugh self taught
  • Start date Start date
H

Hugh self taught

Hi guys,

This is the code I'm currently using to open outlook. (Borrowed it from this
forum somewhere) I may want to put the front end onto multiple machines at
some stage (my own other is an XP 64bit) & the version of Office may be
different so pathing will differ. What would the most efficient way be to
determine where outlook.exe resides & invoking it? I don't want to have to
re-code the database for each machine individually.

Dim retVal As Double

retVal = Shell("C:\Program Files\Microsoft Office\OFFICE12\OUTLOOK.EXE",
vbNormalFocus)

If (retVal = 0) Then
MsgBox "Failed to open Outlook."
End If

Thanks in advance for any guidance on this
 
Awesome thanks Doug, I'll give that a go this evening then post further on my
progress
 
Awesome thanks Doug, I'll give that a go this evening then post further on my
progress
 
Hi Doug

With my limited but growing rapidly knowledge, I've copied the functions
into a new module & to test it, opened a new form to call the function. I now
get a "sub or function not defined" error. That would usually mean a library
ref is missing but I wouldn't know which. The error highlights "RegOpenKeyEx"

Any ideas?
 
Hi Doug

With my limited but growing rapidly knowledge, I've copied the functions
into a new module & to test it, opened a new form to call the function. I now
get a "sub or function not defined" error. That would usually mean a library
ref is missing but I wouldn't know which. The error highlights "RegOpenKeyEx"

Any ideas?
 
You can do one of three things here...

1) Replace the three "Private Declare" function declarations with "Public
Declare" instead. Public makes the function visible to all modules, Private
is usuable only by the module they reside in. So, if your API code is in a
standard module and declared as Private, they won't do you any good from a
form.

2) Move the API module into the Form's module instead of its own.

3) Leave the API code as is but wrap it with a Public Function from inside
the API's standard module (this is my preffered method for dealing with
APIs). Let me explain this a little more...

API's take some pretty screwy arguments sometimes, and the margin for error
is very little, sometimes none. Now take a look at the required arguments
for the three API functions that MS provides. Chances are they don't make a
lot of sense and you're going to put in there whatever's in the sample,
because it works. Not not because we know what it means. As near as I can
tell, the only variable as far as us access programmers are concerned with is
what gets passed from Text1.Text (which is Outlook.Application, or needs to
be, in this case).

What I do to avoid having to come in regular contact with these API
arguments that we mere mortals don't understand is make a 'middle-man'
function. This function is nice and easy and simple for use to use, only
needs to be set up once, and ideally should cut out any chance of accidently
passing a wrong argument (or verifying everything is correct) each time that
we want this value from an API.

So in the module where your API is now, change "Private Sub
Command1_Click()" with "Public Function fGetOutlookExe() As String"

Change:
sProgID = Text1.Text
to:
sProgID = "Outlook.Application"

and last but not least, directly above the "End Sub" Line, put this:
fGetOutlookExe = sPath



And then, from your form, it's becomes as easy as:

<variable> = fGetOutlookExe()

without having to have all this code that we aren't going to change in each
form (such as MS's example of the code behind Command1's Click event... I
think a one-liner is a bit easier to handle).

And there you have functionability of an advanced registry API wrapped up
into a more user-friendly function that takes no argument (pun?? maybe...)

hth
--
Jack Leach
www.tristatemachine.com

"I haven't failed, I've found ten thousand ways that don't work."
-Thomas Edison (1847-1931)
 
You can do one of three things here...

1) Replace the three "Private Declare" function declarations with "Public
Declare" instead. Public makes the function visible to all modules, Private
is usuable only by the module they reside in. So, if your API code is in a
standard module and declared as Private, they won't do you any good from a
form.

2) Move the API module into the Form's module instead of its own.

3) Leave the API code as is but wrap it with a Public Function from inside
the API's standard module (this is my preffered method for dealing with
APIs). Let me explain this a little more...

API's take some pretty screwy arguments sometimes, and the margin for error
is very little, sometimes none. Now take a look at the required arguments
for the three API functions that MS provides. Chances are they don't make a
lot of sense and you're going to put in there whatever's in the sample,
because it works. Not not because we know what it means. As near as I can
tell, the only variable as far as us access programmers are concerned with is
what gets passed from Text1.Text (which is Outlook.Application, or needs to
be, in this case).

What I do to avoid having to come in regular contact with these API
arguments that we mere mortals don't understand is make a 'middle-man'
function. This function is nice and easy and simple for use to use, only
needs to be set up once, and ideally should cut out any chance of accidently
passing a wrong argument (or verifying everything is correct) each time that
we want this value from an API.

So in the module where your API is now, change "Private Sub
Command1_Click()" with "Public Function fGetOutlookExe() As String"

Change:
sProgID = Text1.Text
to:
sProgID = "Outlook.Application"

and last but not least, directly above the "End Sub" Line, put this:
fGetOutlookExe = sPath



And then, from your form, it's becomes as easy as:

<variable> = fGetOutlookExe()

without having to have all this code that we aren't going to change in each
form (such as MS's example of the code behind Command1's Click event... I
think a one-liner is a bit easier to handle).

And there you have functionability of an advanced registry API wrapped up
into a more user-friendly function that takes no argument (pun?? maybe...)

hth
--
Jack Leach
www.tristatemachine.com

"I haven't failed, I've found ten thousand ways that don't work."
-Thomas Edison (1847-1931)
 
Thanks for the help Jack although I'm somehow still not quite there yet.

I've changed the following so far

Public Function fGetOutlookExe() As String
Dim hKey As Long
Dim RetVal As Long
Dim sProgId As String
Dim sCLSID As String
Dim sPath As String

sProgId = Outlook.Application


Then I added OutPath = fGetOutlookExe() to my form whose source =Outpath

I'm probably not seeing the wood for the trees at the moment cos I still
don't get the answer yet.
 
Thanks for the help Jack although I'm somehow still not quite there yet.

I've changed the following so far

Public Function fGetOutlookExe() As String
Dim hKey As Long
Dim RetVal As Long
Dim sProgId As String
Dim sCLSID As String
Dim sPath As String

sProgId = Outlook.Application


Then I added OutPath = fGetOutlookExe() to my form whose source =Outpath

I'm probably not seeing the wood for the trees at the moment cos I still
don't get the answer yet.
 
Replace the code you currently have in the module with this slightly modified
version (hardcoded "Outlook.Application"; changed to a function to return the
value; commented out the msgbox at the end)




'=========================CODESTART
Option Compare Database
Option Explicit

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, 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
'Note that if you declare the lpData parameter as String,
'you must pass it ByVal.


Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long)
As Long

Const REG_SZ As Long = 1
Const KEY_ALL_ACCESS = &H3F
Const HKEY_LOCAL_MACHINE = &H80000002

Public Function fGetOutlookEXE() As String
Dim hKey As Long
Dim RetVal As Long
Dim sProgId As String
Dim sCLSID As String
Dim sPath As String

sProgId = Outlook.Application

'First, get the clsid from the progid
'from the registry key:
'HKEY_LOCAL_MACHINE\Software\Classes\<PROGID>\CLSID
RetVal = RegOpenKeyEx(HKEY_LOCAL_MACHINE, "Software\Classes\" & _
sProgId & "\CLSID", 0&, KEY_ALL_ACCESS, hKey)
If RetVal = 0 Then
Dim n As Long
RetVal = RegQueryValueEx(hKey, "", 0&, REG_SZ, "", n)
sCLSID = Space(n)
RetVal = RegQueryValueEx(hKey, "", 0&, REG_SZ, sCLSID, n)
sCLSID = Left(sCLSID, n - 1) 'drop null-terminator
RegCloseKey hKey
End If

'Now that we have the CLSID, locate the server path at
'HKEY_LOCAL_MACHINE\Software\Classes\CLSID\
' {xxxxxxxx-xxxx-xxxx-xxxx-xxxxxxxxxx}\LocalServer32

RetVal = RegOpenKeyEx(HKEY_LOCAL_MACHINE, _
"Software\Classes\CLSID\" & sCLSID & "\LocalServer32", 0&, _
KEY_ALL_ACCESS, hKey)
If RetVal = 0 Then
RetVal = RegQueryValueEx(hKey, "", 0&, REG_SZ, "", n)
sPath = Space(n)

RetVal = RegQueryValueEx(hKey, "", 0&, REG_SZ, sPath, n)
sPath = Left(sPath, n - 1)
'MsgBox sPath
RegCloseKey hKey
End If

fGetOutlookEXE = sPath
End Function
'=========================CODEEND





Type this into the immediate window:

?fgetoutlookexe

and hit enter. You should now see a return similar to:

?fgetoutlookexe
C:\PROGRA~1\MICROS~2\OFFICE11\OUTLOOK.EXE

We want to make sure the API is working before we try assigning it to a
variable.

Let us know how you make out.


(techincal note: this API apparently can take version specific arguments as
well, such as Outlook.Application.12 for version 12, etc.. Though the API
can take it, the hardcoded "Outlook.Application" is NOT version specific...
most people only have one version installed, but if there is more than one
version of outlook installed on the computer, I'm not positive what the
return will be. Presumably the latest installed copy, but I do not know for
sure.)

--
Jack Leach
www.tristatemachine.com

"I haven't failed, I've found ten thousand ways that don't work."
-Thomas Edison (1847-1931)
 
Replace the code you currently have in the module with this slightly modified
version (hardcoded "Outlook.Application"; changed to a function to return the
value; commented out the msgbox at the end)




'=========================CODESTART
Option Compare Database
Option Explicit

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, 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
'Note that if you declare the lpData parameter as String,
'you must pass it ByVal.


Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long)
As Long

Const REG_SZ As Long = 1
Const KEY_ALL_ACCESS = &H3F
Const HKEY_LOCAL_MACHINE = &H80000002

Public Function fGetOutlookEXE() As String
Dim hKey As Long
Dim RetVal As Long
Dim sProgId As String
Dim sCLSID As String
Dim sPath As String

sProgId = Outlook.Application

'First, get the clsid from the progid
'from the registry key:
'HKEY_LOCAL_MACHINE\Software\Classes\<PROGID>\CLSID
RetVal = RegOpenKeyEx(HKEY_LOCAL_MACHINE, "Software\Classes\" & _
sProgId & "\CLSID", 0&, KEY_ALL_ACCESS, hKey)
If RetVal = 0 Then
Dim n As Long
RetVal = RegQueryValueEx(hKey, "", 0&, REG_SZ, "", n)
sCLSID = Space(n)
RetVal = RegQueryValueEx(hKey, "", 0&, REG_SZ, sCLSID, n)
sCLSID = Left(sCLSID, n - 1) 'drop null-terminator
RegCloseKey hKey
End If

'Now that we have the CLSID, locate the server path at
'HKEY_LOCAL_MACHINE\Software\Classes\CLSID\
' {xxxxxxxx-xxxx-xxxx-xxxx-xxxxxxxxxx}\LocalServer32

RetVal = RegOpenKeyEx(HKEY_LOCAL_MACHINE, _
"Software\Classes\CLSID\" & sCLSID & "\LocalServer32", 0&, _
KEY_ALL_ACCESS, hKey)
If RetVal = 0 Then
RetVal = RegQueryValueEx(hKey, "", 0&, REG_SZ, "", n)
sPath = Space(n)

RetVal = RegQueryValueEx(hKey, "", 0&, REG_SZ, sPath, n)
sPath = Left(sPath, n - 1)
'MsgBox sPath
RegCloseKey hKey
End If

fGetOutlookEXE = sPath
End Function
'=========================CODEEND





Type this into the immediate window:

?fgetoutlookexe

and hit enter. You should now see a return similar to:

?fgetoutlookexe
C:\PROGRA~1\MICROS~2\OFFICE11\OUTLOOK.EXE

We want to make sure the API is working before we try assigning it to a
variable.

Let us know how you make out.


(techincal note: this API apparently can take version specific arguments as
well, such as Outlook.Application.12 for version 12, etc.. Though the API
can take it, the hardcoded "Outlook.Application" is NOT version specific...
most people only have one version installed, but if there is more than one
version of outlook installed on the computer, I'm not positive what the
return will be. Presumably the latest installed copy, but I do not know for
sure.)

--
Jack Leach
www.tristatemachine.com

"I haven't failed, I've found ten thousand ways that don't work."
-Thomas Edison (1847-1931)
 
I replaced the original with your copy (one line wrapped but corrected it)
Ran fGetOutlookEXE but only got a single line feed without any data as a
response. I prefer not to be version specific as although I have Office 2007,
I'll be putting this onto a machine with 2003 so this DB is in 2003 format.
Any suggestions of where to look for the problem?
 
I replaced the original with your copy (one line wrapped but corrected it)
Ran fGetOutlookEXE but only got a single line feed without any data as a
response. I prefer not to be version specific as although I have Office 2007,
I'll be putting this onto a machine with 2003 so this DB is in 2003 format.
Any suggestions of where to look for the problem?
 
Any suggestions of where to look for the problem?

Unfortunately, no. This was copy and pasted direct from a fresh db I threw
on my desktop to test it, and the return I got was
C:\PROGRA~1\MICROS~2\OFFICE11\OUTLOOK.EXE

Check for another wrapped line perhaps? And I'm assuming you have the basic
three references, access, vba and dao3.6

If you'd like I'll send you a zip of my working copy (2003) and you can play
around with that. If you do want to, send me an email to dymondjack at
hotmail dot com and I'll reply with the zip (I didn't see your email address
posted).

ErezM's suggestion is a good one also... using just plain outlook.exe
*should* force the system to get the registered copy of filepath, which is
the same thing this API does. But thereagain, *should* isn't always *is*, so
an API to get it may be a slight bit more reliable.

--
Jack Leach
www.tristatemachine.com

"I haven't failed, I've found ten thousand ways that don't work."
-Thomas Edison (1847-1931)
 
Any suggestions of where to look for the problem?

Unfortunately, no. This was copy and pasted direct from a fresh db I threw
on my desktop to test it, and the return I got was
C:\PROGRA~1\MICROS~2\OFFICE11\OUTLOOK.EXE

Check for another wrapped line perhaps? And I'm assuming you have the basic
three references, access, vba and dao3.6

If you'd like I'll send you a zip of my working copy (2003) and you can play
around with that. If you do want to, send me an email to dymondjack at
hotmail dot com and I'll reply with the zip (I didn't see your email address
posted).

ErezM's suggestion is a good one also... using just plain outlook.exe
*should* force the system to get the registered copy of filepath, which is
the same thing this API does. But thereagain, *should* isn't always *is*, so
an API to get it may be a slight bit more reliable.

--
Jack Leach
www.tristatemachine.com

"I haven't failed, I've found ten thousand ways that don't work."
-Thomas Edison (1847-1931)
 
Here's a version that uses an enumerated list of the available office
applications per the KB article. Include the version number as an optional
argument to fGetOfficeExe or leave blank.


'======= CODE START
Option Compare Database
Option Explicit

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, 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
'Note that if you declare the lpData parameter as String,
'you must pass it ByVal.


Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long)
As Long

Const REG_SZ As Long = 1
Const KEY_ALL_ACCESS = &H3F
Const HKEY_LOCAL_MACHINE = &H80000002

Public Enum eOfficeApp
eOfficeAppaccess = 0
eOfficeAppExcel = 1
eOfficeAppoutlook = 2
eOfficeAppPowerpoint = 3
eOfficeAppword = 4
eOfficeAppFrontPage = 5
End Enum


Public Function fGetOfficeEXE(lApp As eOfficeApp, _
Optional lVer As Long _
) As String
Dim hKey As Long
Dim RetVal As Long
Dim sProgId As String
Dim sCLSID As String
Dim sPath As String

Select Case lApp
Case 0: sProgId = "Access"
Case 1: sProgId = "Excel"
Case 2: sProgId = "Outlook"
Case 3: sProgId = "Powerpoint"
Case 4: sProgId = "Word"
Case 5: sProgId = "FrontPage"
End Select

sProgId = sProgId & ".Application"

If Not IsMissing(lVer) Then sProgID = sProgID & "." & Trim(Str(lVer))

'First, get the clsid from the progid
'from the registry key:
'HKEY_LOCAL_MACHINE\Software\Classes\<PROGID>\CLSID
RetVal = RegOpenKeyEx(HKEY_LOCAL_MACHINE, "Software\Classes\" & _
sProgId & "\CLSID", 0&, KEY_ALL_ACCESS, hKey)
If RetVal = 0 Then
Dim n As Long
RetVal = RegQueryValueEx(hKey, "", 0&, REG_SZ, "", n)
sCLSID = Space(n)
RetVal = RegQueryValueEx(hKey, "", 0&, REG_SZ, sCLSID, n)
sCLSID = Left(sCLSID, n - 1) 'drop null-terminator
RegCloseKey hKey
End If

'Now that we have the CLSID, locate the server path at
'HKEY_LOCAL_MACHINE\Software\Classes\CLSID\
' {xxxxxxxx-xxxx-xxxx-xxxx-xxxxxxxxxx}\LocalServer32

RetVal = RegOpenKeyEx(HKEY_LOCAL_MACHINE, _
"Software\Classes\CLSID\" & sCLSID & "\LocalServer32", 0&, _
KEY_ALL_ACCESS, hKey)
If RetVal = 0 Then
RetVal = RegQueryValueEx(hKey, "", 0&, REG_SZ, "", n)
sPath = Space(n)

RetVal = RegQueryValueEx(hKey, "", 0&, REG_SZ, sPath, n)
sPath = Left(sPath, n - 1)
'MsgBox sPath
RegCloseKey hKey
End If

fGetOfficeEXE = sPath
End Function
'=======CODE END

--
Jack Leach
www.tristatemachine.com

"I haven''t failed, I''ve found ten thousand ways that don''t work."
-Thomas Edison (1847-1931)
 
Here's a version that uses an enumerated list of the available office
applications per the KB article. Include the version number as an optional
argument to fGetOfficeExe or leave blank.


'======= CODE START
Option Compare Database
Option Explicit

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, 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
'Note that if you declare the lpData parameter as String,
'you must pass it ByVal.


Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long)
As Long

Const REG_SZ As Long = 1
Const KEY_ALL_ACCESS = &H3F
Const HKEY_LOCAL_MACHINE = &H80000002

Public Enum eOfficeApp
eOfficeAppaccess = 0
eOfficeAppExcel = 1
eOfficeAppoutlook = 2
eOfficeAppPowerpoint = 3
eOfficeAppword = 4
eOfficeAppFrontPage = 5
End Enum


Public Function fGetOfficeEXE(lApp As eOfficeApp, _
Optional lVer As Long _
) As String
Dim hKey As Long
Dim RetVal As Long
Dim sProgId As String
Dim sCLSID As String
Dim sPath As String

Select Case lApp
Case 0: sProgId = "Access"
Case 1: sProgId = "Excel"
Case 2: sProgId = "Outlook"
Case 3: sProgId = "Powerpoint"
Case 4: sProgId = "Word"
Case 5: sProgId = "FrontPage"
End Select

sProgId = sProgId & ".Application"

If Not IsMissing(lVer) Then sProgID = sProgID & "." & Trim(Str(lVer))

'First, get the clsid from the progid
'from the registry key:
'HKEY_LOCAL_MACHINE\Software\Classes\<PROGID>\CLSID
RetVal = RegOpenKeyEx(HKEY_LOCAL_MACHINE, "Software\Classes\" & _
sProgId & "\CLSID", 0&, KEY_ALL_ACCESS, hKey)
If RetVal = 0 Then
Dim n As Long
RetVal = RegQueryValueEx(hKey, "", 0&, REG_SZ, "", n)
sCLSID = Space(n)
RetVal = RegQueryValueEx(hKey, "", 0&, REG_SZ, sCLSID, n)
sCLSID = Left(sCLSID, n - 1) 'drop null-terminator
RegCloseKey hKey
End If

'Now that we have the CLSID, locate the server path at
'HKEY_LOCAL_MACHINE\Software\Classes\CLSID\
' {xxxxxxxx-xxxx-xxxx-xxxx-xxxxxxxxxx}\LocalServer32

RetVal = RegOpenKeyEx(HKEY_LOCAL_MACHINE, _
"Software\Classes\CLSID\" & sCLSID & "\LocalServer32", 0&, _
KEY_ALL_ACCESS, hKey)
If RetVal = 0 Then
RetVal = RegQueryValueEx(hKey, "", 0&, REG_SZ, "", n)
sPath = Space(n)

RetVal = RegQueryValueEx(hKey, "", 0&, REG_SZ, sPath, n)
sPath = Left(sPath, n - 1)
'MsgBox sPath
RegCloseKey hKey
End If

fGetOfficeEXE = sPath
End Function
'=======CODE END

--
Jack Leach
www.tristatemachine.com

"I haven''t failed, I''ve found ten thousand ways that don''t work."
-Thomas Edison (1847-1931)
 
oops... IsMissing only works on Variant Optionals... updated version below

sorry about that...



'====== CODE START

Option Compare Database
Option Explicit

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, 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
'Note that if you declare the lpData parameter as String,
'you must pass it ByVal.


Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long)
As Long

Const REG_SZ As Long = 1
Const KEY_ALL_ACCESS = &H3F
Const HKEY_LOCAL_MACHINE = &H80000002

Public Enum eOfficeApp
eOfficeAppaccess = 0
eOfficeAppExcel = 1
eOfficeAppoutlook = 2
eOfficeAppPowerpoint = 3
eOfficeAppword = 4
eOfficeAppFrontPage = 5
End Enum


Public Function fGetOfficeEXE(lApp As eOfficeApp, _
Optional vVer As Variant) As String
Dim hKey As Long
Dim RetVal As Long
Dim sProgId As String
Dim sCLSID As String
Dim sPath As String

Select Case lApp
Case 0: sProgId = "Access"
Case 1: sProgId = "Excel"
Case 2: sProgId = "Outlook"
Case 3: sProgId = "Powerpoint"
Case 4: sProgId = "Word"
Case 5: sProgId = "FrontPage"
End Select

sProgId = sProgId & ".Application"

If Not IsMissing(vVer) Then sProgId = sProgId & "." & Trim(CStr(vVer))

'First, get the clsid from the progid
'from the registry key:
'HKEY_LOCAL_MACHINE\Software\Classes\<PROGID>\CLSID
RetVal = RegOpenKeyEx(HKEY_LOCAL_MACHINE, "Software\Classes\" & _
sProgId & "\CLSID", 0&, KEY_ALL_ACCESS, hKey)
If RetVal = 0 Then
Dim n As Long
RetVal = RegQueryValueEx(hKey, "", 0&, REG_SZ, "", n)
sCLSID = Space(n)
RetVal = RegQueryValueEx(hKey, "", 0&, REG_SZ, sCLSID, n)
sCLSID = Left(sCLSID, n - 1) 'drop null-terminator
RegCloseKey hKey
End If

'Now that we have the CLSID, locate the server path at
'HKEY_LOCAL_MACHINE\Software\Classes\CLSID\
' {xxxxxxxx-xxxx-xxxx-xxxx-xxxxxxxxxx}\LocalServer32

RetVal = RegOpenKeyEx(HKEY_LOCAL_MACHINE, _
"Software\Classes\CLSID\" & sCLSID & "\LocalServer32", 0&, _
KEY_ALL_ACCESS, hKey)
If RetVal = 0 Then
RetVal = RegQueryValueEx(hKey, "", 0&, REG_SZ, "", n)
sPath = Space(n)

RetVal = RegQueryValueEx(hKey, "", 0&, REG_SZ, sPath, n)
sPath = Left(sPath, n - 1)
'MsgBox sPath
RegCloseKey hKey
End If

fGetOfficeEXE = sPath
End Function

'====== CODE END

--
Jack Leach
www.tristatemachine.com

"I haven't failed, I've found ten thousand ways that don't work."
-Thomas Edison (1847-1931)
 
Back
Top