我根据南客的示例代码,改写了创建ACCESS财务数据库,可能是由于更新日期的原因,提示VBS出错,请帮助修改一下.谢谢.
公式1:
fa:=FINANCE(0);fb:=FINANCE(1);fc:=FINANCE(7);fd:=FINANCE(33);
fe:=FINANCE(50);ff:=FINANCE(21);fg:=FINANCE(30);fh:=FINANCE(34);
fi:=FINANCE(37);fj:=FINANCE(40);fk:=FINANCE(48);fl:=FINANCE(49);
fm:=FINANCE(53);fn:=FINANCE(54);
gpdm:=stklabel; scdm:=MARKETLABEL;
fy:=year; fm:=month; fd:=day;
<%
va=ffl.vardata("fa")
vb=ffl.vardata("fb")
vc=ffl.vardata("fc")
vd=ffl.vardata("fd")
ve=ffl.vardata("fe")
vf=ffl.vardata("ff")
vg=ffl.vardata("fg")
vh=ffl.vardata("fh")
vi=ffl.vardata("fi")
vj=ffl.vardata("fj")
vk=ffl.vardata("fk")
vl=ffl.vardata("fl")
vm=ffl.vardata("fm")
vn=ffl.vardata("fn")
gpdm=ffl.vardata("gpdm")
scdm=ffl.vardata("scdm")
vdate0=ffl.vardata("fa")
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
va(i)=Rs.Fields("日期")
vb(i)=Rs.Fields("总股本")
vc(i)=Rs.Fields("流通A股")
vd(i)=Rs.Fields("每股收益")
ve(i)=Rs.Fields("股东总数")
vf(i)=Rs.Fields("主营利润")
vg(i)=Rs.Fields("净利润")
vh(i)=Rs.Fields("每股净资产")
vi(i)=Rs.Fields("净资产收益率")
vj(i)=Rs.Fields("经营现金流量")
vk(i)=Rs.Fields("应收帐款周转率")
vl(i)=Rs.Fields("存货周转率")
vm(i)=Rs.Fields("主营业务增长率")
vn(i)=Rs.Fields("税后利润增长率")
Rs.MoveNext
next
End if
Set Rs=Nothing
Set Conn=Nothing
End Sub
ffl.vardata("fa")=va
ffl.vardata("fb")=vb
ffl.vardata("fc")=vc
ffl.vardata("fd")=vd
ffl.vardata("fe")=ve
ffl.vardata("ff")=vf
ffl.vardata("fg")=vg
ffl.vardata("fh")=vh
ffl.vardata("fi")=vi
ffl.vardata("fj")=vj
ffl.vardata("fk")=vk
ffl.vardata("fl")=vl
ffl.vardata("fm")=vm
ffl.vardata("fn")=vn
%>
每股收益:fd;
公式2:
fa:=FINANCE(0);fb:=FINANCE(1);fc:=FINANCE(7);fd:=FINANCE(33);
fe:=FINANCE(50);ff:=FINANCE(21);fg:=FINANCE(30);fh:=FINANCE(34);
fi:=FINANCE(37);fj:=FINANCE(40);fk:=FINANCE(48);fl:=FINANCE(49);
fm:=FINANCE(53);fn:=FINANCE(54);
gpdm:=stklabel; scdm:=MARKETLABEL;
fy:=year; fm:=month; fd:=day;
<%
va=ffl.vardata("fa")
vb=ffl.vardata("fb")
vc=ffl.vardata("fc")
vd=ffl.vardata("fd")
ve=ffl.vardata("fe")
vf=ffl.vardata("ff")
vg=ffl.vardata("fg")
vh=ffl.vardata("fh")
vi=ffl.vardata("fi")
vj=ffl.vardata("fj")
vk=ffl.vardata("fk")
vl=ffl.vardata("fl")
vm=ffl.vardata("fm")
vn=ffl.vardata("fn")
gpdm=ffl.vardata("gpdm")
scdm=ffl.vardata("scdm")
vdate0=ffl.vardata("fa")
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(vdate0(i))
Rs.AddNew
Rs.Fields("日期")=vdate
Rs.Fields("总股本")=Round(vb(i),2)
Rs.Fields("流通A股")=Round(vc(i),2)
Rs.Fields("每股收益")=Round(vd(i),2)
Rs.Fields("股东总数")=Round(ve(i),2)
Rs.Fields("主营利润")=Round(vf(i),2)
Rs.Fields("净利润")=Round(vg(i),2)
Rs.Fields("每股净资产")=Round(vh(i),2)
Rs.Fields("净资产收益率")=Round(vi(i),2)
Rs.Fields("经营现金流量")=Round(vj(i),2)
Rs.Fields("应收帐款周转率")=Round(vk(i),2)
Rs.Fields("存货周转率")=Round(vl(i),2)
Rs.Fields("主营业务增长率")=Round(vm(i),2)
Rs.Fields("税后利润增长率")=Round(vn(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
%>
fd;
