Function AccWya() As String
Dim P As Integer, DesAcex As String
DesAcex = PathReg("11.0\Access\InstallRoot", "Path") 'Common
DesAcex = Trim(DesAcex)
P = InStr(DesAcex, "OFFICE11\")
If P > 0 Then DesAcex = Left(DesAcex, P - 1) & "OFFICE11\"
'If Right(DesAcex, 1) <> "\" Then DesAcex = DesAcex & "\"
'DesAcex = UCase(DesAcex)
'DesAcex = DesAcex & "MSACCESS.EXE "
'DesAcex = "C:\Program Files\Microsoft Office\OFFICE12\MSACCESS.EXE "
'DesAcex = ""
If dir(DesAcex) = "" Then '12.0 Access InstallRoot Path.txt
DesAcex = PathReg("12.0\Access\InstallRoot", "Path")
DesAcex = Trim(DesAcex)
'DesAcex = CStr(DesAcex)
P = InStr(DesAcex, "OFFICE12\")
If P > 0 Then DesAcex = Left(DesAcex, P - 1) & "OFFICE12\"
'DesAcex = DesAcex + "MSACCESS.EXE "
End If
'MsgBox DesAcex
If Right(DesAcex, 1) <> "\" Then DesAcex = DesAcex & "\"
DesAcex = UCase(DesAcex)
AccWya = DesAcex
'MsgBox AccWya
AccWya = AccWya & "MSACCESS.EXE "
'MsgBox AccWya
End Function
Function PathReg(VersionP, PathKey)
1001 Dim phkResult As Long, SA As SECURITY_ATTRIBUTES
1002 Dim lResult As Long, Index As Long, dwReserved As Long, szBuffer As String, _
lBuffSize As Long, szBuffer2 As String, lBuffSize2 As Long, lType As Long, FT As FILETIME
1003 hKey = HKEY_LOCAL_MACHINE '设定主Key
1004 SubKey = "Software\Microsoft\office\" & VersionP & "\" '设定子Key
1005 lResult = RegOpenKeyEx(hKey, SubKey, 0, 1, phkResult) '开启
1006 Index = 0
1007 dwReserved = 0
1008 Do While lResult = ERROR_SUCCESS
1009 szBuffer = Space(255)
1010 lBuffSize = Len(szBuffer)
1011 szBuffer2 = Space(255)
1012 lBuffSize2 = Len(szBuffer2)
1013 lResult = RegEnumValue(phkResult, Index, szBuffer, lBuffSize, _
dwReserved, lType, szBuffer2, lBuffSize2)
1014 If Left(szBuffer, lBuffSize) = PathKey Then '找到了
1015 PathReg = Left(szBuffer2, lBuffSize2) '传回路径
1016 Exit Function
1017 End If
1018 Index = Index + 1
1019 Loop
1020 PathReg = ""
End Function