Office中国论坛/Access中国论坛

标题: 关于SysCmd(acSysCmdAccessDir) 的问题 [打印本页]

作者: 好学 时间: 2007-11-19 11:22
标题: 关于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 时间: 2007-11-19 14:26
为什么要SysCmd(acSysCmdAccessDir) ？
直接：shell "msaccess.exe " & CurrentProject.Path & "\sjch.mdb"

作者: 好学 时间: 2007-11-19 15:54
baije没有路径打不开啊!请试试

作者: 好学 时间: 2007-11-19 16:17
还有我要补充说的是我是在VB打开ACCESS的,没有明确msaccess.exe 的路径打不开，想不到好的办法

作者: andymark 时间: 2007-11-19 17:44
获取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

作者: 好学 时间: 2007-11-20 09:15
我试过了不行,请问我那搞错了?谢谢!

[attach]26952[/attach]

作者: andymark 时间: 2007-11-20 10:49
Dim cc, DD As String

cc = OfficePath("Access.application")

DD = cc & Space(1) & App.Path & "\db1.mdb /Runtime"

Call Shell(DD, 1)

作者: 好学 时间: 2007-11-20 11:20
可以了,谢谢andymark了!

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

作者: 好学 时间: 2007-11-20 16:32
当我将office安装在D盘时，打开ACCESS就出错了：

[attach]26956[/attach]

作者: andymark 时间: 2007-11-20 17:02
用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)

作者: 好学 时间: 2007-11-20 18:12
但这个方法是在设计状态打开的,还有就是显示ACCESS的起动框,请问可以解决这两个问题吗?

作者: hi-wzj 时间: 2007-11-21 10:02
回11楼问题
在mdb文件所在目录下建立一个和mdb文件同名的bmp文件即可。

作者: tmtony 时间: 2007-11-21 11:05
用API相对会好一些!

作者: 好学 时间: 2007-11-21 20:59
站长,问题还是没有解决啊,请指教!

作者: 好学 时间: 2007-11-22 09:03

这个问题还是没有办法解决?

作者: 好学 时间: 2007-11-23 09:41
andymark我昨晚试了，应该是程序的问题，在VB用：（OFFICE装在D盘时）
Dim cc, DD As String
cc = OfficePath("Access.application")
DD = cc & Space(1) & App.Path & "\db1.mdb /Runtime"
Call Shell(DD, 1)
打开是没有问题的，当VB关闭是就出现这个提示：

[attach]26979[/attach]

可能是程序在找注册表是时候出问题

[ 本帖最后由好学于 2007-11-23 09:44 编辑 ]

作者: andymark 时间: 2007-11-23 10:11
格式化C 盘重新安装WINDOW再试试

作者: 好学 时间: 2007-11-23 21:51
我将C盘格式化后重新安装WINDOWS,将OFFICE安装在D盘,但还是一样这样出错.看来是程序的问题了.

作者: andymark 时间: 2007-11-23 22:07
直接用绝对路径行不行?

作者: 好学 时间: 2007-11-23 22:31
用绝对路径打开是正常的，但我们要考虑客户可能将OFFICE安装有不同的盘中，所以要考虑到这个问题。

作者: t小宝 时间: 2007-11-24 12:40
标题: 提供参考
我的XP系统和OFFICE都安装在D盘,在ACCESS中使用andymark提供的获取OFFICE安装路径的函数,没有出现问题!
在VB中就没试过了...

作者: baije 时间: 2007-11-24 13:11
VB中是不行的，我以前出想过办法，一直未解决

后来我用ACCESS来运行SHELL

作者: 好学 时间: 2007-11-24 14:53

原帖由 t小宝 于 2007-11-24 12:40 发表
我的XP系统和OFFICE都安装在D盘,在ACCESS中使用andymark提供的获取OFFICE安装路径的函数,没有出现问题!
在VB中就没试过了...

应该是在VB获取OFFICE安装路径时出问题，所以打开是没有问题的，主要是在VB关闭是出来这个出错的提示框，现在也想不到好的办法，只能到高手们有什么好办法了

作者: 好学 时间: 2007-11-26 21:29
andymark我的这个问题没有解决,有办法吗?

欢迎光临 Office中国论坛/Access中国论坛 (http://www.office-cn.net/)