如何检测当前机器中是否安装word及其版本??
解决方案 »
- wmp控件问题
- 有请各位大神进来坐坐..Access数据库的问题.谢谢...
- vb 能不能多个form共用一个winsocket控件
- filecopy 语句没执行 请问 是 什么 原因
- 怎么在取得一个网址(href属性)时,取得它的src属性和alt属性?
- 直接访问某个ASP
- WaitForSingleObject这个API使用时的一个问题
- 我想获得本机的计算机名,有API如何调用?
- 介绍几个好的vb网站,谁知道?
- 请问,如果把字符转化成图片,用打印机打印,会有什么影响?会不会
- 十万火急!!!我编写的系统拷贝到其它机器后,trim,time,date等系统就不认识了?
- 各位大哥大姐,有熟悉visual Foxpro 的吗?有问题急需解决!!
On Error Resume Next
Set oWordApp = CreateObject("WORD.application")
If Err <>429 Then
Set oWordApp = Nothing
MsgBox "已安装Word."
ELSE
MsgBox "还未安装Word."
End If
On Error GoTo 0
Option ExplicitConst REG_EXPAND_SZ = 2
Const HKEY_CLASSES_ROOT = &H80000000
Const HKEY_CURRENT_USER = &H80000001
Const HKEY_LOCAL_MACHINE = &H80000002
Const HKEY_USERS = &H80000003
Const HKEY_PERFORMANCE_DATA = &H80000004
Const ERROR_SUCCESS = 0&Const RegLocation = "software\UnpreXisten\Online Code Browser\"
Const RegKey = HKEY_LOCAL_MACHINE
Dim AppVer As String * 8Declare Function RegCloseKey Lib "advapi32.dll" (ByVal Hkey As Long) As LongDeclare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal Hkey As Long, ByVal lpSubKey As String, phkResult As Long) As LongDeclare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal Hkey As Long, ByVal lpSubKey As String) As LongDeclare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal Hkey As Long, ByVal lpValueName As String) As LongDeclare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal Hkey As Long, ByVal lpSubKey As String, phkResult As Long) As LongDeclare 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 LongDeclare 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 Long
Const REG_SZ = 1
Const REG_DWORD = 4Public Enum OfficeVer
Office_97
Office_2000
Office_xp
Office_2003
End Enum
'<CSCM>
'--------------------------------------------------------------------------------
' 工 程 名: 工程1
' 函 数 名: GetString
' 变 量 : OfKind (OfficeVer)
' 输 入:无
' 输 出:OFFICE 的路径
'我的机器没有OFFICE xp 根据97 200 2003的关系
'可以看出键值为"HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Office\10.0\Common\InstallRoot"
' 日 期 : 2005-7-5
' 作 者 : 许仙
'--------------------------------------------------------------------------------
'</CSCM>
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 As Long
Dim intZeroPos As Integer, 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(lDataBufSize, " ")
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 IfEnd Function
MsgBox GetInstalledOfficeVersion()
End Sub'本函数运行不需要机器上安装过Office
'经典的判断Office版本函数,原创!
'支持到Office 2003
Function GetInstalledOfficeVersion() As String
On Error Resume Next
Dim WD
Dim OfficeVer As String
OfficeVer = 0
GetInstalledOfficeVersion = ""
Set WD = CreateObject("Word.Application.8")
OfficeVer = CStr(WD.Version)
WD.quit
If Not WD Is Nothing Then Set WD = Nothing
If InStr(OfficeVer, "8") <> 0 Then
GetInstalledOfficeVersion = "Office 97"
ElseIf InStr(OfficeVer, "9") <> 0 Then
GetInstalledOfficeVersion = "Office 2000"
ElseIf InStr(OfficeVer, "10") <> 0 Then
GetInstalledOfficeVersion = "Office XP 2002"
ElseIf InStr(OfficeVer, "11") <> 0 Then
GetInstalledOfficeVersion = "Office 2003"
End If
If Err.Number = 424 Then
Err.Clear
GetInstalledOfficeVersion = "没有安装 Microsoft Office"
End If
End Function