关于SysCmd(acSysCmdAccessDir) 的问题

好学

Private Sub Command0_Click()
Dim xtpf, cxph, fs, d, v As String
Dim str4 As String
xtpf = CurrentProject.Path'当前路径
cxph = Left(xtpf, 3)
Set fs = CreateObject("Scripting.FileSystemObject")
Set d = fs.GetDrive(fs.GetDriveName(fs.GetAbsolutePathName(cxph)))
v = Hex(d.SerialNumber)
Dim RetVal
str4 = """"
Dim strMDB As String
     Shell str4 & SysCmd(acSysCmdAccessDir) & "msaccess.exe" & str4 & " " & str4 & xtpf & "\sjch.mdb"  & "", 2
End Sub  

    以上的代码可以打开ACCESS,但在有些电脑使用就打不开了,可能是SysCmd(acSysCmdAccessDir) 找不到msaccess.exe文件,如果用绝对路径就可以.但如果OFFICE安装在别的盘用绝对路径就不行了,请问有其它方法代替SysCmd(acSysCmdAccessDir) 吗?

[ 本帖最后由 好学 于 2007-11-19 11:26 编辑 ]

baije

为什么要SysCmd(acSysCmdAccessDir) ？
直接：shell "msaccess.exe " & CurrentProject.Path & "\sjch.mdb"

好学

baije没有路径打不开啊!请试试

好学

还有我要补充说的是我是在VB打开ACCESS的,没有明确msaccess.exe 的路径打不开，想不到好的办法

andymark

获取OFFICE的安装路径
Public Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias _
   "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, _
   ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) _
   As Long

Public Declare Function RegQueryValueEx Lib "advapi32.dll" Alias _
   "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, _
   ByVal lpReserved As Long, lpType As Long, _
   ByVal lpData As String, lpcbData As Long) As Long
                                                      
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long

Const REG_SZ As Long = 1
Const KEY_ALL_ACCESS = &H3F
Const HKEY_LOCAL_MACHINE = &H80000002

Public Function OfficePath(OfficeID As String) As String
'用途：获取OFFICE安装路径
'用法:  OfficePath "Access.Aplication"
Dim hKey As Long
Dim RetVal As Long
Dim sProgId As String
Dim sCLSID As String
Dim sPath As String

   sProgId = OfficeID

   RetVal = RegOpenKeyEx(HKEY_LOCAL_MACHINE, "Software\Classes\" & _
      sProgId & "\CLSID", 0&, KEY_ALL_ACCESS, hKey)
   If RetVal = 0 Then
      Dim n As Long
      RetVal = RegQueryValueEx(hKey, "", 0&, REG_SZ, "", n)
      sCLSID = Space(n)
      RetVal = RegQueryValueEx(hKey, "", 0&, REG_SZ, sCLSID, n)
      sCLSID = Left(sCLSID, n - 1)  'drop null-terminator
      RegCloseKey hKey
   End If
   
   
    RetVal = RegOpenKeyEx(HKEY_LOCAL_MACHINE, _
        "Software\Classes\CLSID\" & sCLSID & "\LocalServer32", 0&, _
      KEY_ALL_ACCESS, hKey)
   If RetVal = 0 Then
      RetVal = RegQueryValueEx(hKey, "", 0&, REG_SZ, "", n)
      sPath = Space(n)

      RetVal = RegQueryValueEx(hKey, "", 0&, REG_SZ, sPath, n)
      sPath = Left(sPath, n - 1)
      OfficePath = sPath
    '  MsgBox OfficePath
      RegCloseKey hKey
   End If
End Function

好学

我试过了不行,请问我那搞错了?谢谢!

andymark

Dim cc, DD As String
   
    cc = OfficePath("Access.application")
   
    DD = cc & Space(1) & App.Path & "\db1.mdb /Runtime"
   
    Call Shell(DD, 1)

好学

可以了,谢谢andymark了!

[ 本帖最后由 好学 于 2007-11-20 11:24 编辑 ]

好学

当我将office安装在D盘时，打开ACCESS就出错了：

andymark

用API,不需要判断ACCESS安装在那个盘
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

Call ShellExecute(hwnd, "Open", "test.txt", "", CurrentProject.Path, 1)