ACCESS 数据输入查询计算连接.docx
《ACCESS 数据输入查询计算连接.docx》由会员分享，可在线阅读，更多相关《ACCESS 数据输入查询计算连接.docx（21页珍藏版）》请在冰豆网上搜索。
ACCESS数据输入查询计算连接
第4章数据输入、查询、计算、连接：
通过英特网的ACCESS联接
在ACCESS中使用ADO：
PrivateSubABC_Click（）
DimcnAsNewADODB.Connection
DimrsAsNewADODB.Recordset
cn.OPEN"DSN=alwin;UID=;PWD=;"
rs.OPEN"Select*fromtbTABLE",cn,adOpenDynamic,adLockReadOnly’
rs.ABCApp.Path&"\testdata.dat",adPersistADTG
rs.Close
cn.Close
MsgBox（"OPERATIONOK"）
EndSub
PrivateSubOPEN_Click（）
DimstrConnectAsString
strConnect="Provider=MSPersist"
DimrsAsNewADODB.Recordset
rs.OPEN"http:
//远程服务器的IP/test/testdata.dat",strConnect
DoWhileNotrs.EOF
Debug.Printrs（"USERID"）.value
rs.MoveNext
Loop
EndSub
将用户输入的身份证号15位数据转化为18位。
FunctionIDCode15to18（sCode15AsString）AsString
'*功能:
将15的身份证号升为18位（根据GB11643-1999）
'*参数:
原来的号码
'*返回:
升位后的18位号码
DimiAsInteger
DimnumAsInteger
DimcodeAsString
num=0
IDCode15to18=Left（sCode15,6）+"19"+Right（sCode15,9）
'计算校验位
Fori=18To2Step-1
num=num+（2^（i-1）Mod11）*（Mid（IDCode15to18,19-i,1））
Nexti
num=numMod11
SelectCasenum
Case0
code="1"
Case1
code="0"
Case2
code="X"
CaseElse
code=Trim（Str（12-num））
EndSelect
IDCode15to18=IDCode15to18+code
EndFunction
据身份证号自动输入出生日期
DimLengthAsInteger
Length=Len（Me.[身份证号]）
IfNotIsNull（Length）Then
IfLength=15Then
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）
ElseIfLength=18Then
Me.[性别]=IIf（Val（Mid（Me.身份证号,17,1））/2=Int（Val（Mid（Me.身份证号,17,1））/2）,"女","男"）
Me.[出生日期]=Mid（[身份证号],7,4）&"-"&Mid（[身份证号],11,2）&"-"&Mid（[身份证号],13,2）
Else
MsgBox"身份证号错误！
"
EndIf
EndIf
两行代码打开另一数据库
PrivateSub命令4_Click（）
OnErrorGoToErr_命令4_Click
DimstrDbAsString
strDb="C:
\db1.mdb"
SendKeys"{F11}%FO"&strDb&"{enter}"
Exit_命令4_Click:
ExitSub
Err_命令4_Click:
MsgBoxErr.Description
ResumeExit_命令4_Click
EndSub
实现打开外部数据库中的报表。
PrivateDeclareFunctionapiSetForegroundWindowLib"user32"_
Alias"SetForegroundWindow"_
（ByValhwndAsLong）_
AsLong
PrivateDeclareFunctionapiShowWindowLib"user32"_
Alias"ShowWindow"_
（ByValhwndAsLong,_
ByValnCmdShowAsLong）_
AsLong
PrivateConstSW_MAXIMIZE=3
PrivateConstSW_NORMAL=1
FunctionfOpenRemoteReport（strMDBAsString,strReportAsString,_
OptionalintViewAsVariant）_
AsBoolean
'strMDB:
外部数据库名称（含路径）
'strReport:
报表名称
'intView:
报表的打开方式
DimobjAccessAsAccess.Application
DimlngRetAsLong
OnErrorGoTofOpenRemoteReport_Err
IfIsMissing（intView）ThenintView=acViewPreview
IfLen（Dir（strMDB））>0Then
SetobjAccess=NewAccess.Application
WithobjAccess
lngRet=apiSetForegroundWindow（.hWndAccessApp）
lngRet=apiShowWindow（.hWndAccessApp,SW_NORMAL）
'第一次调用ShowWindow似乎不做任何事情
lngRet=apiShowWindow（.hWndAccessApp,SW_NORMAL）
.OpenCurrentDatabasestrMDB
.DoCmd.OpenReportstrReport,intView
DoWhileLen（.CurrentDb.Name）>0
DoEvents
Loop
EndWith
EndIf
fOpenRemoteReport_Exit:
OnErrorResumeNext
objAccess.Quit
SetobjAccess=Nothing
ExitFunction
fOpenRemoteReport_Err:
fOpenRemoteReport=False
SelectCaseErr.Number
Case7866:
'mdb已经被用独占方式打开
MsgBox"该数据库：
"&strMDB&_
vbCrLf&"已经被用独占方式打开！
"&vbCrLf_
&vbCrLf&"请重新用共享方式打开，再试一次！
",_
vbExclamation+vbOKOnly,"不能打开数据库"
Case2103:
'报表不存在
MsgBox"在这个"&strMDB&"数据库中不存在该报表：
"&strReport&_
vbCrLf&vbCrLf,_
vbExclamation+vbOKOnly,"报表不存在"
Case7952:
'用户关闭了这个mdb
fOpenRemoteReport=True
CaseElse:
MsgBox"错误#:
"&Err.Number&vbCrLf&Err.Description,_
vbCritical+vbOKOnly,"运行时错误"
EndSelect
ResumefOpenRemoteReport_Exit
EndFunction
为列表框定数据源
Dimstr3AsString
str3="SELECTjhd_mx_jiage.wp_leibieAS类别,jhd_mx_jiage.wp_migcegAS名称,jhd_mx_jiage.wp_xighaoAS型号,jhd_mx_jiage.jhmx_danweiAS单位,jhd_mx_jiage.jhmx_danjiaAS单价FROMjhd_mx_jiage"&"wherejhd_mx_jiage.wp_leibie='"&Listjhlb&"'"
Me.Listjhwp.RowSource=str3
Me.Listjhwp.Requery
为组合框、子窗体设置数据源
下面的示例将组合框的RowSourceType属性设为“Table/Query”，然后将RowSource属性设为“雇员列表”查询。
Forms!
Employees!
cmboNames.RowSourceType="Table/Query"
Forms!
Employees!
cmboNames.RowSource="EmployeeList"
一：
Dimstr1AsString
str1="SELECTziyuag.zy_daihao,ziyuag.zy_mima,ziyuag.zy_ziwu,ziyuag.zy_xigmigFROMziyuag"&"wherezy_daihao='"&Text8dldh&"'andzy_mima='"&Text10dlmm&"'"
Me.Child6zy.Form.RecordSource=str1
Me.Child6zy.Requery
二：
子窗体.FORM.recordsourse="SELECTziyuag.zy_daihao,ziyuag.zy_mima,ziyuag.zy_ziwu,ziyuag.zy_xigmigFROMziyuag"&"wherezy_daihao='"&Text8dldh&"'andzy_mima='"&Text10dlmm&"'"
三：
PrivateSubCommand38_Click（）
DimsjyAsString
DimpdAsInteger
pd=True
sjy="SELECT病历明细表.*FROM病历明细表"
IfNotIsNull（Text0）Then
IfpdThen
sjy=sjy&"where姓名like'"&Text0&"'"
pd=False
Else
sjy=sjy&"and姓名like'"&Text0&"'"
EndIf
EndIf
IfNotIsNull（Text1）AndNotIsNull（Text2）Then
sjy=sjy&"where时间between#"&Text1&"#and#"&Text2&"#"
pd=False
Else
str2=str2&"and时间between#"&Text1&"#and#"&Text2&"#"
EndIf
IfNotIsNull（Text3）Then
IfpdThen
sjy=sjy&"where姓名like'"&Text3&"'"
pd=False
Else
sjy=sjy&"and姓名like'"&Text3&"'"
EndIf
EndIf
Me.子窗体.RowSource=sjy
Me.Requery
EndSub
为主窗体、报表设数据源
使用RecordSource属性可以指定窗体或报表的数据源。
String型，可读写。
一：
DimsjyAsString
sjy="SELECT名单.*FROM名单"&"where姓名like'*"&List101&"*'"
Me.RecordSource=sjy
Requery
二：
me.RecordSource="名单"
用其他ACCESS的表作为本ACCESS窗体的数据源
来源：
ACCESS中国Trynew
在Sql语句中的表名前加上数据库名就行了，下面语句动态引用当前目录的另一MDB文件的表做数据源：
PrivateSubForm_Load（）
Me.RecordSource="SELECT表1.*FROM["&CurrentProject.Path&"\db1.mdb"&"].表1;"
EndSub
用VBA编程把Excel表中数据追加到Access表中
PrivateSubCommand0_Click（）
DoCmd.TransferSpreadsheetacImport,acSpreadsheetTypeExcel9,"temp","c:
\temp.xls",yes
EndSub
VB语句删除记录：
ForI=1To20
SQL="DELETE订单明细IDFROM订单明细WHERE订单明细ID="&I
DoCmd.RunSQLSQL
NextI
或：
CurrentProject.Connection.Execute"DELETE*FROM要删除记录的表"
插入／删除一条记录
新建：
DoCmd.RunCommandacCmdRecordsGoToNew
删除：
DoCmd.RunCommandacCmdDeleteRecord
清空表记录的方法
1、CurrentDb（）.Execute"delete*from表名"
2、docmd.runsql"SQL语句"
3，RunSQL"Delete*From表名"
用代码实现对数据修改或增加的取消
在窗体中修改数据时，关闭窗体，数据已经修改，这样很容易产生错误数据.
可采用如下方法解决:
在窗体更新前判断:
PrivateSubFORM_BeforeUpdate（CancelAsInteger）
IfMsgBox（"保存吗?
",vbYesNo,Me.Caption）<>vbYesThen
Cancel=True
EndIf
EndSub
'去除系统的报错信息:
PrivateSubFORM_Error（DataErrAsInteger,ResponseAsInteger）
Response=acDataErrContinue
EndSub
检查数据是否被修改，无则退出，有则询问是否保存
'在窗体的字段的“属性”“事件”“更新后”的右边输入“=NoAllowSave（）”，
'在窗体的“打开”事件中代码“allowSave=False”
'定义模块
OptionCompareDatabase
OptionExplicit
PublicallowSaveAsBoolean
PublicFunctionNoAllowSave（）
allowSave=True
EndFunction
“退出”按钮的单击事件代码
IfallowSave=TrueThen
IfMsgBox（"当前数据已经被修改，是否保存？
",vbYesNo+vbQuestion,"请选择..."）=vbYesThen
Else
Me.Undo
EndIf
EndIf
DoCmd.Close
定义记录集
DimrstAsNewADODB.Recordset
打开记录集
rst.Open"SELECT语句,关键字FROM结果语句表",CurrentProject.Connection,adOpenKeyset,adLockOptimistic
两子窗体之间字段赋值：
Forms!
aaa!
bbb.Form!
bb=Forms!
aaa!
ccc.Form!
cc
确定所显示的当前记录的记录编号。
下面的示例显示如何使用Currentrecord属性来确定所显示的当前记录的记录编号。
在通用过程Currentformrecord中将当前记录的编号值赋给变量Lngrecordnum。
SubCurrentFormRecord（frmAsForm）
DimlngrecordnumAsLong
lngrecordnum=frm.CurrentRecord'CurrentRecord是当前记录号
EndSub
读取最后一条记录
dlast（"字段名","表名"）
在字段默认值中用此函数能使该字段的新纪录显示上一条记录该字段的值
怎样使窗体一打开就定位到指定记录上
定义了一个变量lngbh，要窗体打开时显示ID=Lngbh的这条记录。
DoCmd.OpenForm"formname",acNormal,,"&LNGBH,acFormEdit,acWindowNormal
使用API函数sendmessage，获得光标所在行和列。
Subgetcaretpos（byvalTextHwnd&,LineNo&,ColNo&）
注释：
TextHwnd为TextBox的hWnd属性值，LineNo为所在行数，ColNo为列数
dimI&,j&,k&
注释：
获取起始位置到光标所在位置字节数I=SendMessage（TextHwnd,&HB0&,0,0）j=I/2^16
注释：
确定所在行
LineNo=SendMessage（TextHwnd,&HC9&,j,0）+1
注释：
确定所在列
k=SendMessage（TextHwnd,&HBB&,-1,0）
ColNo=j-k+1
Endsub
如何在打开窗体时自动到相应记录
用法:
DoCmd.RunCommandacCmdRecordsGoToNew
acCmdRecordsGoToFirst移到第一条记录
acCmdRecordsGoToLast移到最后一条记录
acCmdRecordsGoToNew新增一条记录
acCmdRecordsGoToNext移到下一条记录
acCmdRecordsGoToPrevious移到上一条记录
判断记录的位置
来自：
ACCESS中国ysf
me.Recordset.AbsolutePosition=0'第一条记录
me.Recordset.AbsolutePosition=me.Recordset.RecordCount-1'最后一条记录
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（Date（）,"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
自动编号
方法一按时间自动编号：
dima,b
a=dmax（"[自动编号]","编号表"）+1
b=format（date（）,"yyyymm"）&00
ifa>bthen
me.自动编号=a
else
me.自动编号=b+1
endif
方法二，按时间自动编号：
DimaAsString
a=Nz（DMax（"销售单号","销售帐单",""）,0）
IfLeft（a,6）<>Format（Date,"yyyymm"）Then
销售单号=Format（Date,"yyyymm"）&"01"
Else
销售单号=Format（Date,"yyyymm"）&Format（Val（Right（a,2））+1,"00"）
EndIf
方法三，按月分类自动编号：
Dimid,date2AsString
date2="GF"&[部门代码]&Format（[入库日期],"YYYYMM"）
id=DMax（"[rk编号]","[入库单]","[rk编号]Like'"&date2&"?
?
?
'"）
IfIsNull（id）Then
Me.RK编号=dat
升级会员 