ACCESS自定义函数或过程收集整理贴
本贴作为收集大家在用ACCESS时所使用到的自定义函数及过程.
希望大家不要藏私,把好东东都拿出来让大家分享下.

------解决方案--------------------
ACCESS中的自定义函数也就是VB实现的一些函数

很久之前也曾经收集过一下，可是最后也没坚持
http://blog.csdn.net/ACMAIN_CHM/archive/2009/02/20/3915853.aspx
用VB实现一些小函数集
------解决方案--------------------
好贴！
贡献一个，不知有无更好的方法，高手给提点建议！

问题：本人有一个单机ACCESS程序，要在多电脑运行，链接表有20几个，在机器间拷贝时若目录不同，总是要手工修改链接路径，很烦。经多方查找总结，有一个解决方法：自动修改链接表路径

Public Function M_刷新链接表路径()
msql = "SELECT Name FROM MSysObjects WHERE Type = 6 and Left([Name], 4) <> 'MSys'"
Dim rs As New ADODB.Recordset, 文件名 As String, 连接字串 As String
rs.Open msql, CurrentProject.Connection, adOpenKeyset, adLockOptimistic
rs.MoveFirst
For i = 0 To rs.RecordCount - 1
表名 = rs(0)
连接字串 = CurrentDb.TableDefs(表名).Connect
文件名 = M_Get文件名By连接字(连接字串) '这个函数从包含路径的文件名中提取文件名
tps = 连接字串 & CurrentProject.Path & "\" & 文件名
If tps = CurrentDb.TableDefs(表名).Connect Then GoTo 退出:
CurrentDb.TableDefs(表名).Connect = 连接字串 & CurrentProject.Path & "\" & 文件名
CurrentDb.TableDefs(表名).RefreshLink
rs.MoveNext
Next i
退出:
rs.Close
End Function

支持函数1：
Public Function M_Get文件名By连接字(连接字串 As String) As String
Dim tobj As Object, 文件名 As String
Set tobj = CreateObject("Scripting.Dictionary")
Call MY_正则运算("[^\\]+", 连接字串, tobj)
n = tobj.Count - 1
项目列表 = tobj.items
文件名 = 项目列表(n)
连接字串 = 项目列表(0)
连接字串 = Left(连接字串, Len(连接字串) - 2) '把盘符去掉
M_Get文件名By连接字 = 文件名
End Function
支持函数2：
Public Function MY_正则运算(myPattern As String, 待分析字串 As String, 返回字串 As Object)
'此函数的某些内容是其它程序需要，此处不必要但未做修改
Dim objRegExp As RegExp
Dim objMatch As Match
Dim colMatches As MatchCollection
Dim RetStr As String
Set objRegExp = New RegExp '' Create a regular expression object.
objRegExp.pattern = myPattern ''Set the pattern by using the Pattern property.
objRegExp.IgnoreCase = True '' Set Case Insensitivity.
objRegExp.Global = True ''Set global applicability.
M = 0
If (objRegExp.Test(待分析字串) = True) Then
Set colMatches = objRegExp.Execute(待分析字串) '' Execute search.
Dim n As Integer
n = IIf(返回字串.Count > 0, 返回字串.Count + 1, 1)
For Each objMatch In colMatches
返回字串.Add "V" & n, objMatch.Value
n = n + 1
M = M + 1
Next
End If
MY_正则运算 = M
End Function

调用方法：（注意调用时的主窗体不能有绑定数据源，否则失败）
Private Sub Form_Open(Cancel As Integer)’主窗体的事件函数
Call M_刷新链接表路径()
Me.RecordSource = "d_data"'这里设置主窗体的数据源

End Sub

------解决方案--------------------
下面的代码用来调用 ACCESS 中的宏：
procedure TDm.DoAccessMacro(MacroName: string; const Visible: Boolean);

function ConnectAccess(Visible: Boolean): boolean;
var
f: string;
begin
Result := FAccessActive;
if Result then Exit;
try
AccessObj := CreateOleObject('Access.Application');
except
MessageMe('创建Access应用失败。请检查Access的版本，或者请升级MDAC版本。');
AccessObj := null;
FAccessActive := False;
Result := False;
end;
try
f := Mm.DirPath + 'Dat\Report.mdb';
AccessObj.OpenCurrentDatabase(f, True);
FAccessActive := True;
AccessObj.Visible := Visible;