在VB中怎样判断系统中是否安装ACCESS?,

rjacky

不用creatobject的话，比较方便的就是检测注册表HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Office 下的键值了

rjacky

从别处转贴过来的，仅供参考

1. Option Explicit
   
2. 
   
3. Private Declare Function RegOpenKey Lib "advapi32" Alias "RegOpenKeyA" _
   
4. (ByVal hKey As Long, _
   
5. ByVal lpSubKey As String, _
   
6. phkResult As Long) _
   
7. As Long
   
8. 
   
9. Private Declare Function RegQueryValueEx Lib "advapi32" Alias "RegQueryValueExA" _
   
10. (ByVal hKey As Long, _
    
11. ByVal lpValueName As String, _
    
12. lpReserved As Long, _
    
13. lptype As Long, _
    
14. lpData As Any, _
    
15. lpcbData As Long) _
    
16. As Long
    
17. 
    
18. Private Declare Function RegCloseKey& Lib "advapi32" (ByVal hKey&)
    
19. 
    
20. Private Const REG_EXPAND_SZ = 2
    
21. Private Const ERROR_SUCCESS = 0
    
22. Private Const HKEY_CLASSES_ROOT = &H80000000
    
23. 
    
24. 
    
25. Public Function IsAppPresent(ByVal strSubKey$) As Boolean
    
26. 
    
27. IsAppPresent = CBool(Len(GetRegString(HKEY_CLASSES_ROOT, strSubKey)))
    
28. 
    
29. End Function
    
30. 
    
31. Private Sub Command1_Click()
    
32. 
    
33. Label1.Caption = "Access : " & IsAppPresent("Access.Database\CurVer")
    
34. Label2.Caption = "Excel :" & IsAppPresent("Excel.Sheet\CurVer")
    
35. Label3.Caption = "PowerPoint :" & IsAppPresent("PowerPoint.Slide\CurVer")
    
36. Label4.Caption = "Word :" & IsAppPresent("Word.Document\CurVer")
    
37. 
    
38. End Sub
    
39. 
    
40. 
    
41. 
    
42. Public Function GetRegString(ByVal hKey As Long, _
    
43. ByVal strSubKey As String) As String
    
44. 
    
45. Dim strSetting As String
    
46. Dim lngDataLen As Long
    
47. Dim lnghResult As Long
    
48. 
    
49. If RegOpenKey(hKey, strSubKey, lnghResult) = ERROR_SUCCESS Then
    
50. 
    
51. strSetting = Space$(255)
    
52. lngDataLen = Len(strSetting)
    
53. 
    
54. 'lpValueName为vbNullString只读取其默认值
    
55. If RegQueryValueEx(lnghResult, vbNullString, ByVal 0, _
    
56. REG_EXPAND_SZ, ByVal strSetting, lngDataLen) = ERROR_SUCCESS Then
    
57. 
    
58. If lngDataLen > 1 Then
    
59. 
    
60. GetRegString = Left$(strSetting, lngDataLen - 1)
    
61. 
    
62. End If
    
63. 
    
64. End If
    
65. 
    
66. If RegCloseKey(lnghResult) <> ERROR_SUCCESS Then
    
67. 
    
68. MsgBox "RegCloseKey Failed: " & strSubKey, vbCritical
    
69. 
    
70. End If
    
71. 
    
72. End If
    
73. 
    
74. End Function

复制代码