【ACCESS精品源码栏目提醒】:网学会员,鉴于大家对ACCESS精品源码十分关注,论文会员在此为大家搜集整理了“【精品】ACCESS 数据输入查询计算连接 - 其它资料”一文,供大家参考学习!
第4章 数据输入、查询、计算、连接:通过英特网的
ACCESS 联接在
ACCESS 中使用 ADO:Private Sub ABC_ClickDim cn As New ADODB.ConnectionDim rs As New ADODB.Recordsetcn.OPEN quotDSNalwinUIDPWDquotrs.OPEN quotSelect from tbTABLEquot cn adOpenDynamic adLockReadOnly’rs.ABC App.Path amp quottestdata.datquot adPersistADTGrs.Closecn.CloseMsgBox quotOPERATION OKquotEnd SubPrivate Sub OPEN_ClickDim strConnect As StringstrConnect quotProviderMSPersistquotDim rs As New ADODB.Recordsetrs.OPEN quothttp://远程服务器的 IP/test/testdata.datquot strConnectDo While Not rs.EOFDebug.Print rsquotUSERIDquot.valuers.MoveNextLoopEnd Sub将用户输入的身份证号 15 位数据转化为 18 位。
Function IDCode15to18sCode15 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 LeftsCode15 6 quot19quot RightsCode15 9 计算校验位 For i 18 To 2 Step -1 num num 2 i - 1 Mod 11 MidIDCode15to18 19 - i 1 Next i num num Mod 11 Select Case num Case 0 code quot1quot Case 1 code quot0quot Case 2 code quotXquot Case Else code TrimStr12 - num End Select IDCode15to18 IDCode15to18 codeEnd Function据身份证号自动输入出生日期Dim Length As IntegerLength LenMe.身份证号If Not IsNullLength Then If Length 15 Then Me.性别 IIfValMidMe.身份证号 15 1 / 2 IntValMidMe.身份证号 15 1 / 2 quot女quotquot男quot Me.出生日期 quot19quot amp Mid身份证号 7 2 amp quot-quot amp Mid身份证号 9 2 amp quot-quot amp Mid身份证号 11 2ElseIf Length 18 Then Me.性别 IIfValMidMe.身份证号 17 1 / 2 IntValMidMe.身份证号 17 1 / 2 quot女quot quot男quot Me.出生日期 Mid身份证号 7 4 amp quot-quot amp Mid身份证号 11 2 amp quot-quot amp Mid身份证号 13 2 Else MsgBox quot身份证号错误!quot End IfEnd If两行代码打开另一数据库Private Sub 命令 4_ClickOn Error GoTo Err_命令 4_ClickDim strDb As StringstrDb quotC:db1.mdbquotSendKeys quotF11FOquot amp strDb amp quotenterquotExit_命令 4_Click: Exit SubErr_命令 4_Click: MsgBox Err.Description Resume Exit_命令 4_ClickEnd Sub实现打开外部数据库中的报表。
Private Declare Function apiSetForegroundWindow Lib quotuser32quot _ Alias quotSetForegroundWindowquot _ ByVal hwnd As Long _ As LongPrivate Declare Function apiShowWindow Lib quotuser32quot _ Alias quotShowWindowquot _ ByVal hwnd As Long _ ByVal nCmdShow As Long _ As LongPrivate Const SW_MAXIMIZE 3Private Const SW_NORMAL 1Function fOpenRemoteReportstrMDB 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 IsMissingintView Then intView acViewPreview If LenDirstrMDB gt 0 Then Set objAccess New
Access.Application With objAccess lngRet apiSetForegroundWindow.hWndAccessApp lngRet apiShowWindow.hWndAccessApp SW_NORMAL 第一次调用 ShowWindow 似乎不做任何事情 lngRet apiShowWindow.hWndAccessApp SW_NORMAL .OpenCurrentDatabase strMDB .DoCmd.OpenReport strReport intView Do While Len.CurrentDb.Name gt 0 DoEvents Loop End With End IffOpenRemoteReport_Exit: On Error Resume Next objAccess.Quit Set objAccess Nothing Exit FunctionfOpenRemoteReport_Err: fOpenRemoteReport False Select Case Err.Number Case 7866: mdb 已经被用独占方式打开 MsgBox quot该数据库:quot amp strMDB amp _ vbCrLf amp quot已经被用独占方式打开!quot amp vbCrLf _ amp vbCrLf amp quot请重新用共享方式打开,再试一次!quot _ vbExclamation vbOKOnly quot不能打开数据库quot Case 2103: 报表不存在 MsgBox quot在这个quot amp strMDB amp quot数据库中不存在该报表:quot amp strReport amp _ vbCrLf amp vbCrLf _ vbExclamation vbOKOnly quot报表不存在quot Case 7952: 用户关闭了这个 mdb fOpenRemoteReport True Case Else: MsgBox quot错误: quot amp Err.Number amp vbCrLf amp Err.Description _ vbCritical vbOKOnly quot运行时错误quot End Select Resume fOpenRemoteReport_ExitEnd Function为列表框定数据源Dim str3 As Stringstr3 quotSELECT jhd_mx_jiage.wp_leibie AS 类 别 jhd_mx_jiage.wp_migceg AS 名 称 jhd_mx_jiage.wp_xighao AS 型 号 jhd_mx_jiage.jhmx_danwei AS 单 位 jhd_mx_jiage.jhmx_danjia AS 单价 FROM jhd_mx_jiage quot amp quot where jhd_mx_jiage.wp_leibiequotamp Listjhlb amp quotquotMe.Listjhwp.RowSource str3Me.Listjhwp.Requery为组合框、子窗体设置数据源下面的示例将组合框的 RowSourceType 属性设为“Table/Query”,然后将 RowSource 属性设为“雇员列表”查询。
FormsEmployeescmboNames.RowSourceType quotTable/QueryquotFormsEmployeescmboNames.RowSource quotEmployeeListquot一:Dim str1 As Stringstr1 quotSELECT ziyuag.zy_daihao ziyuag.zy_mimaziyuag.zy_ziwuziyuag.zy_xigmig FROMziyuag quot amp quot where zy_daihaoquot amp Text8dldh amp quotand zy_mimaquot amp Text10dlmm amp quotquotMe.Child6zy.Form.RecordSource str1Me.Child6zy.Requery二:子 窗 体 .FORM.recordsoursequotSELECT ziyuag.zy_daihaoziyuag.zy_mimaziyuag.zy_ziwuziyuag.zy_xigmig FROM ziyuag quot amp quot where zy_daihaoquot ampText8dldh amp quotand zy_mimaquot amp Text10dlmm amp quotquot三:Private Sub Command38_ClickDim sjy As StringDim pd As Integerpd Truesjy quotSELECT 病历明细表. FROM 病历明细表quotIf Not IsNullText0 Then If pd Then sjy sjy amp quot where 姓名 like quot amp Text0 amp quotquot pd False Else sjy sjy amp quot and 姓名 like quot amp Text0 amp quotquot End IfEnd IfIf Not IsNullText1 And Not IsNullText2 Then sjy sjy amp quot where 时间 between quot amp Text1 amp quot and quot amp Text2 amp quotquot pd False Else str2 str2 amp quot and 时间 between quot amp Text1 amp quot and quot amp Text2 amp quotquotEnd IfIf Not IsNullText3 Then If pd Then sjy sjy amp quot where 姓名 like quot amp Text3 amp quotquot pd False Else sjy sjy amp quot and 姓名 like quot amp Text3 amp quotquot End IfEnd IfMe.子窗体.RowSource sjyMe.RequeryEnd Sub为主窗体、报表设数据源使用 RecordSource 属性可以指定窗体或报表的数据源。
String 型,可读写。
一:Dim sjy As Stringsjy quotSELECT 名单. FROM 名单quot amp quot where 姓名 like quot amp List101 amp quotquotMe.RecordSource sjyRequery二:me.RecordSource quot名单quot用其他
ACCESS 的表作为本
ACCESS 窗体的数据源来源:
ACCESS 中国 Trynew在 Sql 语句中的表名前加上数据库名就行了,下面语句动态引用当前目录的另一 MDB 文件的表做数据源:Private Sub Form_Load Me.RecordSource quotSELECT 表 1. FROM quot amp CurrentProject.Path amp quotdb1.mdbquot amp quot.表 1quotEnd Sub用 VBA 编程把 Excel 表中数据追加到
Access 表中Private Sub Command0_ClickDoCmd.TransferSpreadsheet acImport acSpreadsheetTypeExcel9 quottempquot quotc:temp.xlsquotyesEnd SubVB 语句删除记录:For I 1 To 20SQL quotDELETE 订单明细 ID FROM 订单明细 WHERE 订单明细 IDquot amp IDoCmd.RunSQL SQLNext I或:CurrentProject.Connection.Execute quotDELETE FROM 要删除记录的表quot插入/删除一条记录新建:DoCmd.RunCommand acCmdRecordsGoToNew删除:DoCmd.RunCommand acCmdDeleteRecord清空表记录的方法1、CurrentDb.Execute quotdelete from 表名quot2、docmd.runsql quotSQL 语句quot3,RunSQL quotDelete From 表名quot用代码实现对数据修改或增加的取消在窗体中修改数据时,关闭窗体,数据已经修改,这样很容易产生错误数据.可采用如下方法解决:在窗体更新前判断:Private Sub FORM_BeforeUpdateCancel As Integer If MsgBoxquot保存吗quot vbYesNo Me.Caption ltgt vbYes Then Cancel True End IfEnd Sub 去除系统的报错信息: Private Sub FORM_ErrorDataErr As Integer Response As Integer Response acDataErrContinue End Sub检查数据是否被修改,无则退出,有则询问是否保存在窗体的字段的“属性”“事件”“更新后”的右边输入“NoAllowSave”,在窗体的“打开”事件中代码“allowSave False”定义模块Option Compare DatabaseOption ExplicitPublic allowSave As BooleanPublic Function NoAllowSave allowSave TrueEnd Function“退出”按钮的单击事件代码If allowSave True Then If MsgBoxquot当前数据已经被修改,是否保存?quot vbYesNo vbQuestion quot请选择...quot vbYes Then Else Me.Undo End IfEnd IfDoCmd.Close定义记录集Dim rst As New ADODB.Recordset打开记录集rst.Open quotSELECT 语 句 关 键 字 FROM 结 果 语 句 表 quot CurrentProject.ConnectionadOpenKeyset adLockOptimistic两子窗体之间字段赋值: Formsaaabbb.Formbb Formsaaaccc.Formcc确定所显示的当前记录的记录编号。
。
下面的示例显示如何使用 Currentrecord 属性来确定所显示的当前记录的记录编号 在通用过程 Currentformrecord 中将当前记录的编号值赋给变量 Lngrecordnum。
Sub CurrentFormRecordfrm As Form Dim lngrecordnum As Long lngrecordnum frm.CurrentRecord CurrentRecord 是当前记录号End Sub读取最后一条记录dlastquot字段名quotquot表名quot在字段默认值中用此函数能使该字段的新纪录显示上一条记录该字段的值怎样使窗体一打开就定位到指定记录上定义了一个变量 lngbh,要窗体打开时显示 IDLngbh 的这条记录。
DoCmd.OpenForm quotformnamequot acNormal quotamp LNGBH acFormEdit acWindowNormal使用 API 函数 sendmessage,获得光标所在行和列。
Sub getcaretposbyval TextHwndampLineNoampColNoamp 注释:TextHwnd 为 TextBox 的 hWnd 属性值, LineNo 为所在行数,ColNo 为列数 dim Iampjampkamp 注释:获取起始位置到光标所在位置字节数 ISendMessageTextHwndampHB0amp00jI/216 注释:确定所在行LineNoSendMessageTextHwndampHC9ampj01 注释:确定所在列 kSendMessageTextHwndampHBBamp-10 ColNoj-k1End sub如何在打开窗体时自动到相应记录用法:DoCmd.RunCommand acCmdRecordsGoToNewacCmdRecordsGoToFirst 移到第一条记录acCmdRecordsGoToLast 移到最后一条记录acCmdRecordsGoToNew 新增一条记录acCmdRecordsGoToNext 移到下一条记录acCmdRecordsGoToPrevious 移到上一条记录判断记录的位置来自:
ACCESS 中国 ysfme.Recordset.AbsolutePosition 0 第一条记录me.Recordset.AbsolutePosition me.Recordset.RecordCount -1 最后一条记录me.Recordset.AbsolutePosition-1 第一条记录前 me.Recordset.boftrueme.Recordset.AbsolutePositionme.Recordset.RecordCount 最 后 一 条 记 录 后me.Recordset.eoftrueme.Recordset.AbsolutePositionn 第 n1 条记录判断为是否新增记录me.newrecordtrueme.newrecordfalse自动编号一:IIfLeftNzDMaxquotjhd_idquotquotjinhuodanquotquotquot06ltgtFormatDatequotyyyymmquotFormatDatequotyyyymmquot amp quot001quotFormatDatequotyyyymmquot ampFormatValRightNzDMaxquotjhd_idquotquotjinhuodanquotquotquot031quot000quot二:nzDLookUpquot编号quotquot登记表quotquotidDMaxid登记表quot1自动编号方法一按时间自动编号:dim abadmaxquot自动编号quotquot编号表quot1bformatdatequotyyyymmquot amp 00if agtb thenme.自动编号aelseme.自动编号b1end if方法二,按时间自动编号:Dim a As String a NzDMaxquot销售单号quot quot销售帐单quot quotquot 0If Lefta 6 ltgt FormatDate quotyyyymmquot Then 销售单号 FormatDate quotyyyymmquot amp quot01quotElse 销售单号 FormatDate quotyyyymmquot amp FormatValRighta 2 1 quot00quotEnd If方法三,按月分类自动编号:Dim id date2 As String date2 quotGFquot amp 部门代码 amp Format入库日期 quotYYYYMMquot id DMaxquotrk 编号quot quot入库单quot quotrk 编号 Like quot amp date2 amp quotquot If IsNullid Then Me.RK 编号 date2 amp quot001quot Else Me.RK 编号 date2 amp FormatCStrCIntRightid 3 1 quot000quot End If按任意输入的日期值的年月自动编号Dim a b cc FormatMe.凭证日期 quotyyyymmquotb Nzc 0 1000a NzDMaxquot凭证号码quot quot凭证quot quotformat凭证.凭证日期yyyymmformatforms凭证录入.凭证日期yyyymmquot 0 1If a gt b Then Me.凭证号码 aElse: Me.凭证号码 b 1End If新增一条记录时使用 Right 及 DMax 函数让字段的数字部分自动加 1答:使用 Right 及 DMax 函数返回字段“FOO”的数字部分的最大值,然后加 1表达式为:quotREC-quot amp rightDMaxquotFOOquot quotFOOTablequot _LenDMaxquotFOOquot quotFOOTablequot - _InStr1 DMaxquotFOOquot quotFOOTablequot quot-quot 1注意:但如果很多用户或多个程序都使用 DMax 去实现这个结果的话,特别在一个很大的表中这个过程会很慢,所以建议使用 DefaultValue,它仅仅使用 DMax 一次程序如下,写在更新事件中Private Sub SomeField_AfterUpdateDim strMax as stringstrMax DMaxquotFOOquot quotFOOTablequotmeHiddenFooCtl quotREC-quot amp rightstrMax lenstrMax - Instr1strMax quot-quot 1End Sub用按钮在窗体中添加新记录Private Sub 添加新记录_Click DoCmd.GoToRecord acNewRecEnd Sub从文本框里输入新的数据库路径,然后更新链接。
Private Sub Command0_ClickDim cat As ADOX.CatalogDim tdf As ADOX.TableMe.txtDBnewNAME.SetFocusSet cat New ADOX.CatalogSet cat.ActiveConnection CurrentProject.ConnectionSet tdf cat.Tablesquotmytablequottdf.Propertiesquotjet oledb:link datasourcequotMe.txtDBnewNAME.TextEnd Sub查看当前库的路径方法 1. CurrentProject.Path方法 2.Dim DBLongname DBName DBDir As StringDBLongname CodeDb.NameDBName DirDBLongnameDBDir LeftDBLongname LenDBLongname - LenDBNameMsgBox quot数据库所在目录:quot amp 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 quotprovidermicrosoft.jet.oledb.4.0passworduser data sourcequot _ amp quotC:Program Fileszhanyexing123.mdbJet OLEDB:Database Password;quotSet appAccess New ADODB.Connection appAccess.Open strCn Set cat New ADOX.Catalog cat.ActiveConnection appAccess路径改成自己的,如果有密码则在红色的 Password后面写上正确的密码,别的照抄就行了如何更该链接表的设置来源:ALEX例 如 , 数 据 库 当 前 的 路 径 可 以 用 application.CurrentProject.Path 得 到 , 然 后 用application.CurrentProject.Path quotlinkabc.mdbquot就可 以指向 数据库安 装目 录 下 面link 子目录下的 ABC.MDB。
如何在 ADP 启动时判断数据库连接是否有效并重新连接这是微软 MSDN 中,在 ADP 项目中创建 ADP 的数据库的默认连接的代码Public Function sCreateConnectionsSvrName As String sUID As String sPWD As StringsDatabase As String As String该函数在 ADP 中检查连接,如果没有,它将通过输入参数创建一个连接输入: sSvrName 数据库服务器名 sUID 用户名 sPWD 口令 sDatabase MSDE 数据库名输出: 连接状态On Error GoTo sCreateConnectionTrap:If Application.CurrentProject.BaseConnectionString quotquot Then表示 ADP 处于无连接状态sConnectionString quotPROVIDERSQLOLEDB.1PASSWORDquot amp sPWD _amp quotPERSIST SECURITY INFOTRUEUSER amp sUID amp quot _INITIAL CATALOGquot amp sDatabase amp quotDATA SOURCEquot amp sSvrNameApplication.CurrentProject.OpenConnection sConnectionStringsCreateConnection quot创建了到 quot amp sDatabase amp quot 数据库的连接quotElse 连接已存在sCreateConnection quot已经存在到 quot amp sDatabase amp quot 数据库的连接quotEnd IfsCreateConnectionExit:Exit FunctionsCreateConnectionTrap:sCreateConnection Err.DescriptionResume sCreateConnectionExitEnd Function-------------------------------------此例程将从 ADP 删除连接使其处于无连接状态。
Sub MakeADPConnectionlessApplication.CurrentProject.CloseConnection 关闭连接Application.CurrentProject.OpenConnection 将连接设置为无End Sub重新定位链接表二步走来源:爱赛思应用俱乐部 kevindeng尽管 Accxp 网上有很多关于定位链接表的贴子,但还是有很多的朋友询问这方面的问题。
应letter 网友的提议,结合 Alex 总版主的重新定位链接表文件
源码,现将这方面的具体操作介绍如下:假设前台数据库文件名为 frontBase.mdb后台数据库文件名为 backData.mdbfrontBase 当中有链接表 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 IfEnd Function启.