ACCESS VBA编程（四）数据输入、查询、计算、连接（下）

竹笛

新增一条记录时使用Right及DMax函数让字段的数字部分自动加1 答：使用Right及DMax函数返回字段“FOO”的数字部分的最大值，然后加1
表达式为：
="REC-" & right(DMax("FOO", "FOOTable"), _
Len(DMax("FOO", "FOOTable")) - _
InStr(1, DMax("FOO", "FOOTable"), "-")) + 1
注意：但如果很多用户或多个程序都使用DMax去实现这个结果的话，特别在一个很大的表中这个过程会很慢，所以建议使用DefaultValue，它仅仅使用DMax一次
程序如下，写在更新事件中
Private Sub SomeField_AfterUpdate()
Dim strMax as string
strMax =DMax("FOO", "FOOTable")
me!HiddenFooCtl = "REC-" & right(strMax, len(strMax) - Instr(1,strMax, "-")) +1
End Sub

用按钮在窗体中添加新记录
Private Sub 添加新记录_Click()
     DoCmd.GoToRecord , , acNewRec
        End Sub

从文本框里输入新的数据库路径，然后更新链接。
Private Sub Command0_Click()
Dim cat As ADOX.Catalog
Dim tdf As ADOX.Table
Me.txtDBnewNAME.SetFocus
Set cat = New ADOX.Catalog
Set cat.ActiveConnection = CurrentProject.Connection
Set tdf = cat.Tables("mytable")
tdf.Properties("jet oledb:link datasource")=Me.txtDBnewNAME.Text
End Sub

查看当前库的路径
方法1.
= CurrentProject.Path
方法2.
Dim DBLongname, DBName, DBDir As String
DBLongname = CodeDb.Name
DBName = Dir(DBLongname)
DBDir = Left(DBLongname, Len(DBLongname) - Len(DBName))
MsgBox "数据库所在目录：" & DBDir

用ADO打开链接表
这是我以前十分头痛的问题，不知道那一堆一串的是什么意思现在知道了，这个是打开ACCESS的，打开别的表不在此讨论之内。
    Dim appAccess As ADODB.Connection
     Dim strCn, temp As String
     Dim cat As ADOX.Catalog
     Dim rstEmployees As ADODB.Recordset
     Dim intloop As Integer
     Dim tbl1, tblEmp As ADOX.Table
     Dim idx As ADOX.Index
     
     strCn = "provider=microsoft.jet.oledb.4.0;password=;user id=admin; data source=" _
           & "C:\Program Files\zhanyexing\123.mdb;Jet OLEDB:Database Password=；"
Set appAccess = New ADODB.Connection
     appAccess.Open strCn
     Set cat = New ADOX.Catalog
     cat.ActiveConnection = appAccess
路径改成自己的，如果有密码则在红色的Password=后面写上正确的密码，别的照抄就行了

如何更该链接表的设置
例如，数据库当前的路径可以用application.CurrentProject.Path得到，然后用 application.CurrentProject.Path + "\link\abc.mdb"就可以指向数据库安装目录下面 link子目录下的ABC.MDB。
如何在ADP启动时,判断数据库连接是否有效并重新连接
这是微软MSDN中，在ADP项目中创建ADP的数据库的默认连接的代码
Public Function sCreateConnection(sSvrName As String, sUID As String, sPWD As String, sDatabase As String) As String
'********************************************************************
'该函数在ADP中检查连接，如果没有，它将通过输入参数创建一个连接
'
'输入:
' sSvrName 数据库服务器名
' sUID 用户名
' sPWD 口令
' sDatabase MSDE数据库名
'
'输出:
' 连接状态
'
'********************************************************************
On Error GoTo sCreateConnectionTrap:
If Application.CurrentProject.BaseConnectionString = "" Then
'表示ADP处于无连接状态
sConnectionString = "PROVIDER=SQLOLEDB.1;PASSWORD=" & sPWD _
& ";PERSIST SECURITY INFO=TRUE;USER ID=" & sUID & "; _
INITIAL CATALOG=" & sDatabase & ";DATA SOURCE=" & sSvrName
Application.CurrentProject.OpenConnection sConnectionString
sCreateConnection = "创建了到 " & sDatabase & " 数据库的连接!"
Else '连接已存在
sCreateConnection = "已经存在到 " & sDatabase & " 数据库的连接!"
End If
        sCreateConnectionExit:
Exit Function
sCreateConnectionTrap:
sCreateConnection = Err.Description
Resume sCreateConnectionExit
End Function
        -------------------------------------
此例程将从 ADP 删除连接,使其处于无连接状态。
Sub MakeADPConnectionless()
Application.CurrentProject.CloseConnection '关闭连接
Application.CurrentProject.OpenConnection '将连接设置为无
End Sub

重新定位链接表二步走
假设前台数据库文件名为frontBase.mdb
后台数据库文件名为backData.mdb
frontBase当中有链接表tbl1, tbl2, tbl3, …，链接到backData.mdb中
首先我们要在前台数据库文件的启动窗体加载事件中判断链接是否正确，方法是打开任意一个链接表，假设为tbl1，代码如下：
Public Function CheckLinks() As Boolean
' 检查到后台数据库的链接；如果链接存在且正确的话，返回 True 。　　
　　Dim dbs As Database, rst As DAO.Recordset　　
　　Set dbs = CurrentDb()
　　' 打开链接表查看表链接信息是否正确。
　　On Error Resume Next
　　Set rst = dbs.OpenRecordset(“tbl1”)
　　rst.Close
　　' 如果没有错误，返回 True 。
　　If Err = 0 Then
　　　　CheckLinks = True
　　Else
　　　　CheckLinks = False
　　End If　　
End Function

启动窗体的加载事件：
Private Sub FORM_Load()
If CheckLinks = False then
Docmd.OpenFORM “frmConnect”
End If
End Sub
frmConnect 连接窗体如下图
f:\m.bmp

接下来的事情就是如何刷新链接表了。
上面的窗体右边的按钮是用用来调用API打开文件对话框，具体代码如下：
Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Boolean
Type OPENFILENAME
　　lStructSize As Long
　　hwndOwner As Long
　　hInstance As Long
　　lpstrFilter As String
　　lpstrCustomFilter As String
　　nMaxCustFilter As Long
　　nFilterIndex As Long
　　lpstrFile As String
　　nMaxFile As Long
　　lpstrFileTitle As String
　　nMaxFileTitle As Long
　　lpstrInitialDir As String
　　lpstrTitle As String
　　flags As Long
　　nFileOffset As Integer
　　nFileExtension As Integer
　　lpstrDefExt As String
　　lCustData As Long
　　lpfnHook As Long
　　lpTemplateName As String
End Type
Private Sub FileOpen_Click()
　 Dim ofn As OPENFILENAME
　 Dim rtn As String
　 ofn.lStructSize = Len(ofn)
　 ofn.hwndOwner = Me.hwnd
　
　 ofn.lpstrFilter = "数据库文件 (*.mdb)" & vbNullChar & "*.mdb"
　 ofn.lpstrFile = Space(254)
　 ofn.nMaxFile = 255
　 ofn.lpstrFileTitle = Space(254)
　 ofn.nMaxFileTitle = 255
　 ofn.lpstrInitialDir = CurrentProject.Path
　 ofn.lpstrTitle = "后台数据文件为"
　 ofn.flags = 6148
　 rtn = GetOpenFileName(ofn)
　
　 FileName.SetFocus
　 If rtn = True Then
　　　 FileName.Text = ofn.lpstrFile
　　　 FileName.Text = FileName.Text
　　　 OK.Enabled = True
　 Else
　　　 FileName.Text = ""
　 End If
End Sub

连接按钮刷新链接表，代码如下：
Private Sub OK_Click()
Dim tabDef As TableDef
For Each tabDef In CurrentDb.TableDefs
If Len(tabDef.Connect) > 0 Then
tabDef.Connect = ";DATABASE=" & Me.FileName.Text & ";PWD=" + 后台数据库密码
tabDef.RefreshLink
End If
Next
MsgBox "连接成功！"
DoCmd.Close acFORM, Me.Name
End Sub
其实很简单只有两步，判断链接是否正确和刷新链接表。

数据库与照片的关系如何处理？
有照片若干，怎样能在数据库中存储并显示？
1、把照片放进数据库，照片的格式最好是bmp，这样就可以在窗体上显示出来，不过这样数据库的体积会暴增。设一个OLE字段，然后插入对象就行了（对着字段单击右键）
2、不把照片放入数据库，只把照片的路径保存到数据库中，动态加载，这样可以支持很多种图片格式。（见示例）
If Dir(Application.CurrentProject.Path & "\img\" & Me!ID & ".jpg") <> "" Then
     Me!照片.Picture = Application.CurrentProject.Path & "\img\" & Me!ID & ".jpg"
Else
     Me!照片.Picture = Application.CurrentProject.Path & "\img\0.jpg"
End If

导出成EXECL表
DoCmd.TransferSpreadsheet acExport, 8, "" & Text0 & "", "A:\" & Text0 & ".xls", True, ""

如何建立简单的超级连接？
*API函数声明
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecute A" (ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd A s Long) As Long
注释：打开某个网址
ShellExecute 0, "open", " http://tyvb.126.com";, vbNullString, vbNullString, 3
注释：给某个信箱发电子邮件
ShellExecute hwnd, "open", "mailto:sst95@21cn.com", vbNullString, vbNullString, 0

忘得快

谢谢分享！