|
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
判断本机是否安装excel
方法1
\'模块代码
Option Explicit
Private Declare Function RegOpenKey Lib _
"advapi32" Alias "RegOpenKeyA" (ByVal hKey _
As Long, ByVal lpSubKey As String, _
phkResult As Long) As Long
Private Declare Function RegQueryValueEx _
Lib "advapi32" Alias "RegQueryValueExA" _
(ByVal hKey As Long, ByVal lpValueName As _
String, lpReserved As Long, lptype As _
Long, lpData As Any, lpcbData As Long) _
As Long
Private Declare Function RegCloseKey& Lib _
"advapi32" (ByVal hKey&)
Private Const REG_SZ = 1
Private Const REG_EXPAND_SZ = 2
Private Const ERROR_SUCCESS = 0
Public Const HKEY_CLASSES_ROOT = &H80000000
Public Function GetRegString(hKey As Long, _
strSubKey As String, strValueName As _
String) As String
Dim strSetting As String
Dim lngDataLen As Long
Dim lngRes As Long
If RegOpenKey(hKey, strSubKey, _
lngRes) = ERROR_SUCCESS Then
strSetting = Space(255)
lngDataLen = Len(strSetting)
If RegQueryValueEx(lngRes, _
strValueName, ByVal 0, _
REG_EXPAND_SZ, ByVal strSetting, _
lngDataLen) = ERROR_SUCCESS Then
If lngDataLen > 1 Then
GetRegString = Left(strSetting, lngDataLen - 1)
End If
End If
If RegCloseKey(lngRes) <> ERROR_SUCCESS Then
MsgBox "RegCloseKey Failed: " & _
strSubKey, vbCritical
End If
End If
End Function
\'窗体代码:
Function FileExists(sFileName$) As Boolean
On Error Resume Next
FileExists = IIf(Dir(Trim(sFileName)) <> "", True, False)
End Function
Public Function IsAppPresent(strSubKey$, strValueName$) As Boolean
IsAppPresent = CBool(Len(GetRegString(HKEY_CLASSES_ROOT, strSubKey, strValueName)))
End Function
Private Sub Command1_Click()
Label1.Caption = "Access " & IsAppPresent("Access.Database\\CurVer", "")
Label2.Caption = "Excel " & IsAppPresent("Excel.Sheet\\CurVer", "")
Label3.Caption = "PowerPoint " & IsAppPresent("PowerPoint.Slide\\CurVer", "")
Label4.Caption = "Word " & IsAppPresent("Word.Document\\CurVer", "")
End Sub
这是从注册表中获取信息的方法来判定系统中是否安装OFFICE的示例,VB的
--------------------------------------------------------------------------------
方法2
'判断本机是否安装excel
Function ExcelYesNoInsert()
On Error Resume Next
Set excelapp = CreateObject("excel.application")
If Err Then
Err.Clear
MsgBox "本机没有安装Excel,部分功能不能实现。"
ExcelYesNoInsert = False
Else
'MsgBox "安装了excel"
ExcelYesNoInsert = True
End If
Set excelapp = Nothing
End Function
|
|