利用ADO创建、读取Access数据库示例代码-南客 [复制链接]

包含2个公式：
1、ADO创建、刷新Access数据库
2、ADO读取Access数据库
公式代码如下：

一、创建、刷新Access数据库：

源码：
<DIV class=quote>

fc:close;fo:=open;fl:=low;fh:=high;
fv:=vol;
gpdm:=stklabel; scdm:=MARKETLABEL;
fy:=year; fm:=month; fd:=day;
<%
vo=ffl.vardata("fo")
vh=ffl.vardata("fh")
vl=ffl.vardata("fl")
vc=ffl.vardata("fc")
vv=ffl.vardata("fv")
gpdm=ffl.vardata("gpdm")
scdm=ffl.vardata("scdm")
vy=ffl.vardata("fy")
vm=ffl.vardata("fm")
vd=ffl.vardata("fd")
n=ffl.vardata("n")

Const Jet3x = 4 'Access97数据库格式
Const Jet4x = 5 'Access2000数据库格式

'创建 Access2000 数据库,位于飞狐安装目录user子目录下
FileName="user\a2000.mdb"
TableName=scdm & gpdm
Set fso = CreateObject("Scripting.FileSystemObject")
If (Not fso.FileExists(FileName)) Then
CreateNewMDB FileName, Jet4x
End If
On Error Resume Next
CreateNewTable TableName
Dim Conn,RS
WriteTable FileName, TableName
last=ubound(vc)
if Rs.RecordCount<last+1 then
if Rs.RecordCountstart=0 then start=0 else start=last
for i=start to last
vdate=DateSerial(vy(i), vm(i), vd(i))
Rs.AddNew
Rs.Fields("日期")=vdate
Rs.Fields("开盘价")=Round(vo(i),2)
Rs.Fields("最高价")=Round(vh(i),2)
Rs.Fields("最低价")=Round(vl(i),2)
Rs.Fields("收盘价")=Round(vc(i),2)
Rs.Fields("成交量")=Round(vv(i),2)
'Rs.Update
next
Rs.UpdateBatch
End if
Set Rs=Nothing
Set Conn=Nothing

Sub WriteTable(FileName,TableName)
Set Conn=CreateObject("ADODB.Connection")
Conn.Provider="Microsoft.Jet.OLEDB.4.0"
Conn.Open FileName
Set Rs=CreateObject("ADODB.Recordset")
Rs.CursorType = 3
Rs.LockType = 3
Rs.Open TableName, Conn
End Sub

Sub OpenTable(TableName) '打开表
Set Conn=CreateObject("ADODB.Connection")
Conn.Provider="Microsoft.Jet.OLEDB.4.0"
Conn.Open FileName
SQL="Select * From TableName"
Set RS=conn.Execute(SQL)
End Sub

Sub CreateNewTable(TableName) '创建新表
Dim conn,rs
Set conn=CreateObject("ADODB.Connection")
Conn.Provider="Microsoft.Jet.OLEDB.4.0"
Conn.Open FileName
SQL="Create Table " & TableName & "([日期]Text(10),[开盘价]Single,[最高价]Single,[最低价]Single,[收盘价]Single,[成交量]Single)"
Set RS=conn.Execute(SQL)
Set Rs=Nothing
Set Conn=Nothing
End Sub

Sub CreateNewMDB(FileName, Format) '创建Access2000数据库
Dim Catalog
Set Catalog = CreateObject("ADOX.Catalog")
Catalog.Create "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Jet OLEDB:Engine Type=" & Format & _
";Data Source=" & FileName
Set CataLog=Nothing
End Sub
%>

////////

</DIV>

二、读取Access数据库：
源码：

fc:=close;f=fc;fl:=fc;fh:=fc;
fv:=fc;
gpdm:=stklabel; scdm:=MARKETLABEL;
fy:=year; fm:=month; fd:=day;
<%
vo=ffl.vardata("fo")
vh=ffl.vardata("fh")
vl=ffl.vardata("fl")
vc=ffl.vardata("fc")
vv=ffl.vardata("fv")
gpdm=ffl.vardata("gpdm")
scdm=ffl.vardata("scdm")
vy=ffl.vardata("fy")
vm=ffl.vardata("fm")
vd=ffl.vardata("fd")
n=ffl.vardata("n")

Const Jet3x = 4
Const Jet4x = 5
FileName="user\a2000.mdb"
TableName=scdm & gpdm
On Error Resume Next
ReadTable FileName,TableName

Sub ReadTable(FileName,TableName)
Dim Conn,RS
Set Conn=CreateObject("ADODB.Connection")
Conn.Provider="Microsoft.Jet.OLEDB.4.0"
Conn.Open FileName
Set Rs=CreateObject("ADODB.Recordset")
Rs.CursorType = 3
Rs.LockType = 3
Rs.Open TableName, Conn
Rs.MoveFirst
Last=ubound(vc)
if Rs.RecordCount=Last+1 then
for i=0 to Last
vo(i)=Rs.Fields("开盘价")
vh(i)=Rs.Fields("最高价")
vl(i)=Rs.Fields("最低价")
vc(i)=Rs.Fields("收盘价")
vv(i)=Rs.Fields("成交量")
Rs.MoveNext
next
End if
Set Rs=Nothing
Set Conn=Nothing
End Sub

ffl.vardata("fo")=vo
ffl.vardata("fh")=vh
ffl.vardata("fl")=vl
ffl.vardata("fc")=vc
ffl.vardata("fv")=vv
%>
开盘:fo;
最高:fh;
最低:fl;
收盘:fc;
成交:fv,linethick0;


///////////////

操作：
1、调入公式
2、当翻到某只股票时，就自动将该股票的数据写入数据库表中
3、将该公式进行选股或排序，就会将所有股票的所有数据写入数据库，不过很慢的，因为数据量太大了。Access数据库，对于数据量很大的场合，速度会比较慢。