How to detect if there is an Office and its version in the current machine ??

'Author: 9CBS her husband' Homepage: jjweb.126.com'MSN: Coderxu # hotmail.com'QQ: 19030300 'reproduced please keep the article intact, save more author information please cherish the fruits of labor of others

Option expedition

Const REG_EXPAND_SZ = 2Const HKEY_CLASSES_ROOT = & H80000000Const HKEY_CURRENT_USER = & H80000001Const HKEY_LOCAL_MACHINE = & H80000002Const HKEY_USERS = & H80000003Const HKEY_PERFORMANCE_DATA = & H80000004Const ERROR_SUCCESS = 0 &

Const regLocation = "Software / unprexisten / online code browser /" constregs = hkey_local_machinedim appver as string * 8

Declare function regclosekey lib "advapi32.dll" (Byval HKey As Long) AS Long

Declare function regreateKey Lib "Advapi32.dll" Alias ​​"RegcreateKeya" (Byval LPSUBKEY AS STRING, PHKRESULT AS Long) As long

Declare function regdeletekey lib "advapi32.dll" alias "regdeleteKeya" (Byval lpsubkey as string) AS Long

Declare function regdeletevalue lib "advapi32.dll" alias "regdeletevaluea" (Byval HKEY As Long, Byval LPVALUENAME AS STRING) AS Long

Declare function regopenkey lib "advapi32.dll" alias "regopenkeya" (Byval HKey As String, PhkResult As Long) AS Long

Declare Function RegQueryValueEx Lib "advapi32.dll" Alias ​​"RegQueryValueExA" (ByVal Hkey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long

Declare Function RegSetValueEx Lib "advapi32.dll" Alias ​​"RegSetValueExA" (ByVal Hkey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As LongConst REG_SZ = 1Const REG_DWORD = 4PUBLIC ENUM OfficeVer Office_97 Office_2000 Office_XP Office_2003nd Enum '' ------------------------------------- ------------------------------------------ 'Engineering Name: Engineering 1' Function name: getString 'Variable: OFKIND (OFFICEVER)' → no 'output: Office path' My machine No Office XP According to the relationship between 97 200 2003 ', "HKEY_LOCAL_MACHINE / SOFTWARE / Microsoft / OFICE/10.0/common/installroot "" date: 2005-7-5 'author: Xu Xian' ---------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------- -------------------------------------------------- ---- ' public function getOfficePath (OFKIND AS OfficeVer) AS String

Dim LvalueType Dim Keyhand As Long, R Dim Datatype As Long Dim Lresult As Long Dim Strbuf AS String Dim LDATABUFSIZE, STRKEYNAME $

Select Case Ofkind

Case 0 r = regopenkey (HKEY_LOCAL_MACHINE, "Software / Microsoft / Office / 8.0 / Common / InstallRoot", Keyhand) StrKeyName = "Officebin"

Case 1 r = regopenkey (HKEY_LOCAL_MACHINE, "Software / Microsoft / Office / 9.0 / Common / InstallRoot", Keyhand) StrKeyName = "Path"

Case 2 r = regopenkey (HKEY_LOCAL_MACHINE, "Software / Microsoft / Office / 10.0 / Common / InstallRoot", Keyhand) StrKeyName = "PATH"

Case 3 r = regopenkey (HKEY_LOCAL_MACHINE, "Software / Microsoft / Office / 11.0 / Common / InstallRoot", Keyhand) StrKeyName = "Path" End SELECT

LResult = RegQueryValueex (Keyhand, StrKeyname, 0 &, LvalueType, Byval 0 &, LDataBufsize)

If LvalueType = Reg_sz Then

Strbuf = string (ldatabase, ") LRESULT = RegQueryValueex (Keyhand, StrKeyname, 0 &, 0 &, ByVal Strbuf, LDATABUFSIZE)

If LRESULT = Error_Success Then

INTZEROPOS = INSTR (strbuf, chr $ (0))

IF INTZEROPOS> 0 THEN

GetOfficePath = Left $ (strbuf, intzeropos - 1)

Else

GetOfficePath = strbuf

END IF

END IF

END IF

END FUNCTION

Methods of other people writing very good :)

http://blog.9cbs.net/tanaya/archive/2005/04/29/368504.aspx

This function is running without the installation of the machine.

Get the function of the current Office version

Private submmand1_click () msgbox getInstalledOfficeVersion () end sub