如何自主选择连接access数据库外的对象？

yanghua1900363

近期在我使用的数据库上添加了一个“计算器”的按钮，用来调用操作系统中的计算器，使用了
Public Sub calc()
Dim windowMe
windowMe = Shell("e:\我的文档\图片收藏\1\calc.exe")
End Sub
这个函数。
我把数据库和计算器放在“1”这个文件夹里。
可是，我发现：当我把这个文件夹放在优盘的时候，在数据库中再调用计算器，命令就无效了，要么提示错误。
请问如何才能实现当原数据文件变换位置后，在数据库中也能自动连接需要连接数据库外的对象，如计算器？

JosephTan

其实无须定义计算器执行文件的路径就可以调用计算器的：
以下是我的计算器模块：
Option Compare Database
Option Explicit
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Declare Function GetClipboardData Lib "user32" (ByVal wFormat As Long) As Long
Declare Function CloseClipboard Lib "user32" () As Long
Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
Declare Function GlobalSize Lib "kernel32" (ByVal hMem As Long) As Long
Private Const CF_TEXT = 1

Function calculator()
'Dim ctlActiveControl As Control
'Dim strControlName As String
'Dim hwnd As Long
Dim strCalculate As String


'hwnd = GetActiveWindow() '获取活动窗口句柄
'Set ctlActiveControl = Screen.ActiveControl '获取活动控件
'strControlName = ctlActiveControl.Name '焦点控件名字


SendKeys "+{HOME}", True  '全选计算算式
SendKeys "^x", True '剪切计算算式



Dim ReturnValue
ReturnValue = Shell("Calc.EXE", 1) ' 运行计算器。
Call Sleep(500) '延时让计算器有时间打开
AppActivate ReturnValue ' 激活计算器。
SendKeys "%2" '切换到科学模式
SendKeys "+", True '当你的输入法默认是中文的时候需要执行这一条,否则请把它comment掉

strCalculate = GetClipText()
strCalculate = Replace(strCalculate, "^", "y") '以下把常规的科学计算按钮替换为计算器键盘快捷键
strCalculate = Replace(strCalculate, "m-", "{^}q")
strCalculate = Replace(strCalculate, "m+", "{^}p")
strCalculate = Replace(strCalculate, "ms", "{^}m")
strCalculate = Replace(strCalculate, "mr", "{^}r")
strCalculate = Replace(strCalculate, "mc", "{^}l")
strCalculate = Replace(strCalculate, "+-", "{F9}")
strCalculate = Replace(strCalculate, "sqr", "@")
strCalculate = Replace(strCalculate, "degree", "{F3}")
strCalculate = Replace(strCalculate, "rad", "{F4}")
strCalculate = Replace(strCalculate, "grad", "{F5}")
strCalculate = Replace(strCalculate, "inv", "i")
strCalculate = Replace(strCalculate, "mod", "d")
strCalculate = Replace(strCalculate, "sinh", "{^}s")
strCalculate = Replace(strCalculate, "cosh", "{^}o")
strCalculate = Replace(strCalculate, "tanh", "{^}t")
strCalculate = Replace(strCalculate, "ln", "n")
strCalculate = Replace(strCalculate, "int", ";")
strCalculate = Replace(strCalculate, "mc", "{^}l")
strCalculate = Replace(strCalculate, "sin", "s")
strCalculate = Replace(strCalculate, "cos", "o")
strCalculate = Replace(strCalculate, "tan", "t")
strCalculate = Replace(strCalculate, "dms", "m")
strCalculate = Replace(strCalculate, "pi", "p")
strCalculate = Replace(strCalculate, "mc", "{^}l")
strCalculate = Replace(strCalculate, "f-e", "v")
strCalculate = Replace(strCalculate, "mc", "{^}l")
strCalculate = Replace(strCalculate, "exp", "x")
strCalculate = Replace(strCalculate, "sq", "q")
strCalculate = Replace(strCalculate, "cube", "#")
strCalculate = Replace(strCalculate, "log", "l")
strCalculate = Replace(strCalculate, "i^", "{^}y")
strCalculate = Replace(strCalculate, "icube", "{^}b")
strCalculate = Replace(strCalculate, "ilog", "{^}g")

strCalculate = Replace(strCalculate, "(", "{(}") 'senkeys要把+~[]^%()放入{}才可正确发出
strCalculate = Replace(strCalculate, ")", "{)}")
strCalculate = Replace(strCalculate, "+", "{+}")
strCalculate = Replace(strCalculate, "^", "{^}")
strCalculate = Replace(strCalculate, "%", "{%}")
strCalculate = Replace(strCalculate, "~", "{~}")
strCalculate = Replace(strCalculate, "[", "{[}")
strCalculate = Replace(strCalculate, "]", "{]}")





SendKeys strCalculate, True '粘帖计算算式
'Debug.Print strCalculate
Sleep (300)
SendKeys "=", True ' 取得总合。
SendKeys "^c", True '复制结果



SendKeys "%{F4}", True ' 按 ALT+F4 关闭计算器。

'SetForegroundWindow (hwnd) '从新设定活动窗口

'ctlActiveControl.SetFocus '把焦点给回输入框
SendKeys "^v", True '粘帖结果给输入框
SendKeys "{TAB}", True
End Function





Private Function GetClipText() As String
     Dim hMem As Long
     Dim lpData As Long
     Dim nClipSize As Long
     Dim bytClipData() As Byte
     Dim sClipString As String
     
    If OpenClipboard(ByVal 0&) Then                 '如果OpenClipboard函数返回非0值，说明成功打开剪贴板
         hMem = GetClipboardData(CF_TEXT)            '获取剪贴板中以文本格式存在的内存对象的句柄
         If CBool(hMem) Then                         '如果剪贴板中对应的格式不存在，此时的hMem会是0(Null)，这里用CBool把它转换成Boolean类型加以判断
             lpData = GlobalLock(hMem)               '获取内存对象第一个字节的内存地址
             nClipSize = GlobalSize(hMem)            '获取内存对象的字节长度
             ReDim bytClipData(1 To nClipSize)       '修改缓冲字节数组的长度，确保能够容纳内存对象的全部数据
             CopyMemory bytClipData(1), ByVal lpData, nClipSize  '复制内存对象的数据到字节数组中，注意Byval的用法
             sClipString = StrConv(bytClipData, vbUnicode)       '将字节转化成字符串
             GetClipText = sClipString
             'MsgBox "当前剪贴板内的文本是：" & vbCrLf & sClipString '将结果显示给用户
         Else
             MsgBox "当前剪贴板内没有文本"
         End If
         CloseClipboard
     End If
End Function

todaynew

用相对地址即可

CurrentProject.Path为当前运行的Access程序文件的地址。你将其他资源放在这个文件所在的目录或者子文件夹中，就可以以这个地址的相对地址找到文件。比如将calc.exe文件存放在Access程序文件下的一个叫做“引用资源”的子文件夹中，则使用shell函数就可以写为：
Public Sub calc()
   if Shell(CurrentProject.Path & "\引用资源\calc.exe")=0 then exit sub
End Sub

JosephTan

应该是不需要加路径的。

yanghua1900363

todaynew 发表于 2012-2-27 21:21
用相对地址即可

CurrentProject.Path为当前运行的Access程序文件的地址。你将其他资源放在这个文件所在的 ...

谢谢 todaynew老师 你这个方法简捷易学易用！

yanghua1900363

JosephTan 发表于 2012-2-26 04:48
其实无须定义计算器执行文件的路径就可以调用计算器的：
以下是我的计算器模块：
Option Compare Databas ...

俺对编程有点发晕，请问JosephTan老师 这个模块怎么用呀？多谢多谢！

JosephTan

yanghua1900363 发表于 2012-2-28 14:25
俺对编程有点发晕，请问JosephTan老师 这个模块怎么用呀？多谢多谢！

很简单，定义一个快捷键，指向这个模块定义的函数即刻。在某处打一个公式比如3*4然后按那个快捷键，就可以算出结果把结果代替那个公式比如12代替3*4

yanghua1900363

JosephTan 发表于 2012-2-28 11:51
很简单，定义一个快捷键，指向这个模块定义的函数即刻。在某处打一个公式比如3*4然后按那个快捷键，就可以 ...

对JosehpTan老师的热心帮助，再次表示感谢！ “定义一个快捷键，指向模块定义的函数”这句话，俺弄不懂，快捷键怎么定义？怎么把快捷键指向模块？不会呀？，能不能发个实例学习学习。

JosephTan

yanghua1900363 发表于 2012-2-28 15:15
对JosehpTan老师的热心帮助，再次表示感谢！ “定义一个快捷键，指向模块定义的函数”这句话，俺弄不懂， ...

创建名字叫AutoKeys的宏，然后创建下面的子宏(submacro)子宏的名称就可以用快捷键例如{F9}
然后增添子宏的步骤Runcode然后在runcode的下面加上calculator()保存
然后就可以用F9这个快捷键来计算了。

yanghua1900363

JosephTan 发表于 2012-2-28 12:23
创建名字叫AutoKeys的宏，然后创建下面的子宏(submacro)子宏的名称就可以用快捷键例如{F9}
然后增添子宏 ...

谢谢 按图索骥 我来试试