ACCESS 数据输入查询计算连接.docx

1、ACCESS 数据输入查询计算连接第4章 数据输入、查询、计算、连接： 通过英特网的ACCESS联接 在ACCESS中使用ADO： Private Sub ABC_Click() Dim cn As New ADODB.Connection Dim rs As New ADODB.Recordset cn.OPEN DSN=alwin;UID=;PWD=; rs.OPEN Select * from tbTABLE, cn, adOpenDynamic, adLockReadOnly rs.ABC App.Path & testdata.dat, adPersistADTG rs.Close

2、cn.Close MsgBox (OPERATION OK) End Sub Private Sub OPEN_Click() Dim strConnect As String strConnect = Provider=MSPersist Dim rs As New ADODB.Recordset rs.OPEN http:/远程服务器的IP/test/testdata.dat, strConnect Do While Not rs.EOF Debug.Print rs(USERID).value rs.MoveNext Loop End Sub 将用户输入的身份证号15位数据转化为18位。

3、 Function IDCode15to18(sCode15 As String) As String * 功能:将15的身份证号升为18位(根据GB 11643-1999) * 参数:原来的号码 * 返回:升位后的18位号码 Dim i As Integer Dim num As Integer Dim code As String num = 0 IDCode15to18 = Left(sCode15, 6) + 19 + Right(sCode15, 9) 计算校验位 For i = 18 To 2 Step -1 num = num + (2 (i - 1) Mod 11) * (Mi

4、d(IDCode15to18, 19 - i, 1) Next i num = num Mod 11 Select Case num Case 0 code = 1 Case 1 code = 0 Case 2 code = X Case Else code = Trim(Str(12 - num) End Select IDCode15to18 = IDCode15to18 + code End Function 据身份证号自动输入出生日期 Dim Length As Integer Length = Len(Me.身份证号) If Not IsNull(Length) Then If Le

5、ngth = 15 Then Me.性别 = IIf(Val(Mid(Me.身份证号, 15, 1) / 2 = Int(Val(Mid(Me.身份证号, 15, 1) / 2), 女, 男) Me.出生日期 = 19 & Mid(身份证号, 7, 2) & - & Mid(身份证号, 9, 2) & - & Mid(身份证号, 11, 2) ElseIf Length = 18 Then Me.性别 = IIf(Val(Mid(Me.身份证号, 17, 1) / 2 = Int(Val(Mid(Me.身份证号, 17, 1) / 2), 女, 男) Me.出生日期 = Mid(身份证号, 7

6、, 4) & - & Mid(身份证号, 11, 2) & - & Mid(身份证号, 13, 2) Else MsgBox 身份证号错误！ End If End If 两行代码打开另一数据库 Private Sub 命令4_Click() On Error GoTo Err_命令4_Click Dim strDb As String strDb = C:db1.mdb SendKeys F11%FO & strDb & enter Exit_命令4_Click: Exit Sub Err_命令4_Click: MsgBox Err.Description Resume Exit_命令4_Cl

7、ick End Sub 实现打开外部数据库中的报表。 Private Declare Function apiSetForegroundWindow Lib user32 _ Alias SetForegroundWindow _ (ByVal hwnd As Long) _ As Long Private Declare Function apiShowWindow Lib user32 _ Alias ShowWindow _ (ByVal hwnd As Long, _ ByVal nCmdShow As Long) _ As Long Private Const SW_MAXIMIZE

8、 = 3 Private Const SW_NORMAL = 1 Function fOpenRemoteReport(strMDB As String, strReport As String, _ Optional intView As Variant) _ As Boolean strMDB: 外部数据库名称(含路径) strReport: 报表名称 intView: 报表的打开方式 Dim objAccess As Access.Application Dim lngRet As Long On Error GoTo fOpenRemoteReport_Err If IsMissing

9、(intView) Then intView = acViewPreview If Len(Dir(strMDB) 0 Then Set objAccess = New Access.Application With objAccess lngRet = apiSetForegroundWindow(.hWndAccessApp) lngRet = apiShowWindow(.hWndAccessApp, SW_NORMAL) 第一次调用ShowWindow似乎不做任何事情 lngRet = apiShowWindow(.hWndAccessApp, SW_NORMAL) .OpenCurr

10、entDatabase strMDB .DoCmd.OpenReport strReport, intView Do While Len(.CurrentDb.Name) 0 DoEvents Loop End With End If fOpenRemoteReport_Exit: On Error Resume Next objAccess.Quit Set objAccess = Nothing Exit Function fOpenRemoteReport_Err: fOpenRemoteReport = False Select Case Err.Number Case 7866: m

11、db 已经被用独占方式打开 MsgBox 该数据库： & strMDB & _ vbCrLf & 已经被用独占方式打开！ & vbCrLf _ & vbCrLf & 请重新用共享方式打开，再试一次！, _ vbExclamation + vbOKOnly, 不能打开数据库 Case 2103: 报表不存在 MsgBox 在这个 & strMDB & 数据库中不存在该报表： & strReport & _ vbCrLf & vbCrLf , _ vbExclamation + vbOKOnly, 报表不存在 Case 7952: 用户关闭了这个 mdb fOpenRemoteReport = T

12、rue Case Else: MsgBox 错误#: & Err.Number & vbCrLf & Err.Description, _ vbCritical + vbOKOnly, 运行时错误 End Select Resume fOpenRemoteReport_Exit End Function 为列表框定数据源 Dim str3 As String str3 = SELECT jhd_mx_jiage.wp_leibie AS 类别, jhd_mx_jiage.wp_migceg AS 名称, jhd_mx_jiage.wp_xighao AS 型号, jhd_mx_jiage.jh

13、mx_danwei AS 单位, jhd_mx_jiage.jhmx_danjia AS 单价 FROM jhd_mx_jiage & where jhd_mx_jiage.wp_leibie= & Listjhlb & Me.Listjhwp.RowSource = str3 Me.Listjhwp.Requery 为组合框、子窗体设置数据源 下面的示例将组合框的 RowSourceType 属性设为“Table/Query”，然后将 RowSource 属性设为“雇员列表”查询。 Forms!Employees!cmboNames.RowSourceType = Table/Query F

14、orms!Employees!cmboNames.RowSource = EmployeeList 一： Dim str1 As String str1 = SELECT ziyuag.zy_daihao, ziyuag.zy_mima,ziyuag.zy_ziwu,ziyuag.zy_xigmig FROM ziyuag & where zy_daihao= & Text8dldh & and zy_mima= & Text10dlmm & Me.Child6zy.Form.RecordSource = str1 Me.Child6zy.Requery 二： 子窗体.FORM.records

15、ourse=SELECT ziyuag.zy_daihao, ziyuag.zy_mima,ziyuag.zy_ziwu,ziyuag.zy_xigmig FROM ziyuag & where zy_daihao= & Text8dldh & and zy_mima= & Text10dlmm & 三： Private Sub Command38_Click() Dim sjy As String Dim pd As Integer pd = True sjy = SELECT 病历明细表.* FROM 病历明细表 If Not IsNull(Text0) Then If pd Then s

16、jy = sjy & where 姓名 like & Text0 & pd = False Else sjy = sjy & and 姓名 like & Text0 & End If End If If Not IsNull(Text1) And Not IsNull(Text2) Then sjy = sjy & where 时间 between # & Text1 & # and # & Text2 & # pd = False Else str2 = str2 & and 时间 between # & Text1 & # and # & Text2 & # End If If Not I

17、sNull(Text3) Then If pd Then sjy = sjy & where 姓名 like & Text3 & pd = False Else sjy = sjy & and 姓名 like & Text3 & End If End If Me.子窗体.RowSource = sjy Me.Requery End Sub 为主窗体、报表设数据源 使用 RecordSource 属性可以指定窗体或报表的数据源。String 型，可读写。 一： Dim sjy As String sjy = SELECT 名单.* FROM 名单 & where 姓名 like * & List

18、101 & * Me.RecordSource = sjy Requery 二： me.RecordSource = 名单 用其他ACCESS的表作为本ACCESS 窗体的数据源 来源：ACCESS中国 Trynew 在Sql语句中的表名前加上数据库名就行了，下面语句动态引用当前目录的另一MDB文件的表做数据源： Private Sub Form_Load() Me.RecordSource = SELECT 表1.* FROM & CurrentProject.Path & db1.mdb & .表1; End Sub 用VBA编程把Excel表中数据追加到Access表中 Private

19、Sub Command0_Click() DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, temp, c:temp.xls, yes End Sub VB语句删除记录： For I = 1 To 20 SQL = DELETE 订单明细ID FROM 订单明细 WHERE 订单明细ID= & I DoCmd.RunSQL SQL Next I 或： CurrentProject.Connection.Execute DELETE * FROM要删除记录的表 插入删除一条记录 新建：DoCmd.RunCommand acC

20、mdRecordsGoToNew 删除：DoCmd.RunCommand acCmdDeleteRecord 清空表记录的方法 1、CurrentDb().Execute delete * from 表名 2、docmd.runsql SQL语句 3，RunSQL Delete * From 表名 用代码实现对数据修改或增加的取消 在窗体中修改数据时，关闭窗体，数据已经修改，这样很容易产生错误数据. 可采用如下方法解决: 在窗体更新前判断: Private Sub FORM_BeforeUpdate(Cancel As Integer) If MsgBox(保存吗?, vbYesNo, Me.

21、Caption) vbYes Then Cancel = True End If End Sub 去除系统的报错信息: Private Sub FORM_Error(DataErr As Integer, Response As Integer) Response = acDataErrContinue End Sub 检查数据是否被修改，无则退出，有则询问是否保存 在窗体的字段的“属性”“事件”“更新后”的右边输入“=NoAllowSave()”， 在窗体的“打开”事件中代码“allowSave = False” 定义模块 Option Compare Database Option Exp

22、licit Public allowSave As Boolean Public Function NoAllowSave() allowSave = True End Function “退出”按钮的单击事件代码 If allowSave = True Then If MsgBox(当前数据已经被修改，是否保存？, vbYesNo + vbQuestion, 请选择.) = vbYes Then Else Me.Undo End If End If DoCmd.Close 定义记录集 Dim rst As New ADODB.Recordset 打开记录集 rst.Open SELECT 语

23、句, 关键字 FROM 结果语句表, CurrentProject.Connection, adOpenKeyset, adLockOptimistic 两子窗体之间字段赋值： Forms!aaa!bbb.Form!bb = Forms!aaa!ccc.Form!cc 确定所显示的当前记录的记录编号。 下面的示例显示如何使用 Currentrecord 属性来确定所显示的当前记录的记录编号。在通用过程 Currentformrecord 中将当前记录的编号值赋给变量 Lngrecordnum。 Sub CurrentFormRecord(frm As Form) Dim lngrecordnu

24、m As Long lngrecordnum = frm.CurrentRecord CurrentRecord是当前记录号 End Sub 读取最后一条记录 dlast(字段名,表名) 在字段默认值中用此函数能使该字段的新纪录显示上一条记录该字段的值 怎样使窗体一打开就定位到指定记录上 定义了一个变量lngbh，要窗体打开时显示ID=Lngbh的这条记录。 DoCmd.OpenForm formname, acNormal, , & LNGBH, acFormEdit, acWindowNormal 使用API函数sendmessage，获得光标所在行和列。 Sub getcaretpos(

25、byval TextHwnd&,LineNo&,ColNo&) 注释：TextHwnd为TextBox的hWnd属性值， LineNo为所在行数，ColNo为列数 dim I&,j&,k& 注释：获取起始位置到光标所在位置字节数 I=SendMessage(TextHwnd,&HB0&,0,0) j=I/216 注释：确定所在行 LineNo=SendMessage(TextHwnd,&HC9&,j,0)+1 注释：确定所在列 k=SendMessage(TextHwnd,&HBB&,-1,0) ColNo=j-k+1 End sub 如何在打开窗体时自动到相应记录 用法: DoCmd.Run

26、Command acCmdRecordsGoToNew acCmdRecordsGoToFirst 移到第一条记录 acCmdRecordsGoToLast 移到最后一条记录 acCmdRecordsGoToNew 新增一条记录 acCmdRecordsGoToNext 移到下一条记录 acCmdRecordsGoToPrevious 移到上一条记录 判断记录的位置 来自：ACCESS中国 ysf me.Recordset.AbsolutePosition = 0 第一条记录 me.Recordset.AbsolutePosition = me.Recordset.RecordCount -1

27、 最后一条记录 me.Recordset.AbsolutePosition=-1 第一条记录前 me.Recordset.bof=true me.Recordset.AbsolutePosition=me.Recordset.RecordCount 最后一条记录后 me.Recordset.eof=true me.Recordset.AbsolutePosition=n 第n+1条记录 判断为是否新增记录 me.newrecord=true me.newrecord=false 自动编号 一： =IIf(Left(Nz(DMax(jhd_id,jinhuodan,),0),6)Format(D

28、ate(),yyyymm),Format(Date(),yyyymm) & 001,Format(Date(),yyyymm) & Format(Val(Right(Nz(DMax(jhd_id,jinhuodan,),0),3)+1,000) 二： =nz(DLookUp(编号,登记表,id=DMax(id,登记表)+1 自动编号 方法一按时间自动编号： dim a,b a=dmax(自动编号,编号表)+1 b=format(date(),yyyymm) & 00 if ab then me.自动编号=a else me.自动编号=b+1 end if 方法二，按时间自动编号： Dim a

29、As String a = Nz(DMax(销售单号, 销售帐单, ), 0) If Left(a, 6) Format(Date, yyyymm) Then 销售单号 = Format(Date, yyyymm) & 01 Else 销售单号 = Format(Date, yyyymm) & Format(Val(Right(a, 2) + 1, 00) End If 方法三，按月分类自动编号： Dim id, date2 As String date2 = GF & 部门代码 & Format(入库日期, YYYYMM) id = DMax(rk编号, 入库单, rk编号 Like & date2 & ?) If IsNull(id) Then Me.RK编号 = dat