关于Microsoft Office Access的问题

怎样用Microsoft Office Access从wincc数据库中中导出归档变量？如果有能不能写详细点？

问题补充：
有没有更详细的注释，我对数据库不是很清楚，如果有人不嫌麻烦的话，请赐教，我将非常感谢！也可以发我邮箱：401772473@qq.com

最佳答案

在wincc6.0中使用vb脚本采用adox动态创建Access数据库，导出SQL server中的归档数据。楼主可以参考如下代码

数据库创建数据导出代码：

Dim begintime,endtime
Dim dcat,dconn,drs,dpstr
Dim dfm,ddlg,dtbl
Dim sPro,sDsn,sSer,sptr,sConn
Dim sSql1,sSql2
Dim sRs1,sRs2
Dim sCmd1,sCmd2
Dim m, n, s, b
b=timeconv(begintime,endtime,0)
If b=False Then
Exit Sub 
Else
'create new database and table
set dcat = createobject("adox.catalog")
set dconn = createobject("adodb.connection")
set drs = createobject("adodb.recordset")
Set ddlg = ScreenItems("dialog")
ddlg.Filter = "MDB文件(*.mdb)|*.mdb|AllFiles(*.*)|*.*|"
ddlg.FilterIndeX = 1
ddlg.InitDir = "E:\vb code"
ddlg.Flags = 6
ddlg.Action = 2

If ddlg.Filename = "" Then
MsgBox "you must input name"
Exit Sub
Else
dfm =ddlg.FileName
End If
dpstr = "Provider=Microsoft.Jet.OLEDB.4.0;"
dpstr = dpstr & "Data Source=" & dfm
dcat.Create dpstr
Set dtbl = CreateObject("adox.table")
dcat.ActiveConnection = dpstr
dtbl.Name = "MyTable" 
dtbl.Columns.Append "time"
dtbl.Columns.Append "tag1value"
dtbl.Columns.Append "tag2value"
dcat.Tables.Append dtbl
dconn.Open dpstr
drs.CursorLocation = 3
drs.Open "MyTable",dconn, 1, 2
'open sql server database
sPro = "Provider = WinCCOLEDBProvider.1;"
sDsn = "Catalog = CC_test_10_04_21_18_05_57R;"
sSer = "Data Source = .\WinCC"
sptr = sPro + sDsn + sSer
sSql1="TAG:R,'SpeedAndTemp\motor_actual'," &begintime& "," &endtime
sSql2="TAG:R,'SpeedAndTemp\oil_temp'," &begintime& "," &endtime

Set sconn = CreateObject("ADODB.Connection")
sconn.ConnectionString = sptr
sconn.CursorLocation = 3
sconn.Open

Set sRs1 = CreateObject("ADODB.Recordset")
Set scmd1 = CreateObject("ADODB.Command")
sCmd1.CommandType = 1
Set sCmd1.ActiveConnection = sconn
sCmd1.CommandText = sSql1
Set sRs1 = sCmd1.Execute

Set sRs2 = CreateObject("ADODB.Recordset")
Set scmd2 = CreateObject("ADODB.Command")
sCmd2.CommandType = 1
Set sCmd2.ActiveConnection = sconn
sCmd2.CommandText = sSql2
Set sRs2 = sCmd2.Execute
m = sRs1.Fields.Count

If (m > 0) Then
MsgBox "bie"
sRs1.Movefirst
srs2.movefirst
MsgBox "now"
n = 0
Do 
n= n + 1
'If (n>1000) Then Exit Do

drs.AddNew 
drs.Fields(0).Value = FormatDateTime(srs1.fields(1).value)
drs.Fields(1).Value = srs1.fields(2).value
drs.Fields(2).ValUe = srs2.fields(2).value
drs.Update
'End If
dRs.MoveNext
srs1.movenext
srs2.movenext
Loop While Not sRs1.EOF     
dRs.Close
srs1.close
srs2.close
Else
End If
Set drs=Nothing
Set srs1=Nothing
Set srs2=Nothing
sconn.close
dconn.close
Set sconn=Nothing
Set dconn=Nothing
End If 
MsgBox"export success!"

时间判断转换代码：

Function timeconv(begintime,endtime,choice)
'there is still some problems:checktime should return a boolen flag to show whether the number
'is in the range, then in function timeconv shoule check this flag to decide 
'whether Exit funciton Or Not, this function needs to improve!
'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
'begin time returns the begintime you choose from combobox after some processing
'endtime is as upon
'choice is input choice of what process,0 is no processing and 1 is 
'adjust to (GMT)Greenwich Mean Time 
'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
Dim byear,bmonth,bday,bhour,bmin,bsec
Dim eyear,emonth,eday,ehour,emin,esec
Dim btime,etime,newbtime,newetime
Dim timeerr
Dim temph,tempd,stemph,stempd

Set byear = ScreenItems("byear")
Set bmonth = ScreenItems("bmonth")
Set bday = ScreenItems("bday")
Set bhour = ScreenItems("bhour")
Set bmin = ScreenItems("bmin")
Set bsec = ScreenItems("bsec")

Set eyear = ScreenItems("eyear")
Set emonth = ScreenItems("emonth")
Set eday = ScreenItems("eday")
Set ehour = ScreenItems("ehour")
Set emin = ScreenItems("emin")
Set esec = ScreenItems("esec")
'check whether entered begintime is legal or valid

If (Not IsNumeric(byear.text))Or (Not IsNumeric(bmonth.text))Or (Not IsNumeric(bday.text))Or _
   (Not IsNumeric(bhour.text))Or (Not IsNumeric(bmin.text))Or (Not IsNumeric(bsec.text)) Then
   MsgBox "some of you entered begintime is not numeric or null!",vbOKCancel,"wrong time"
   timeconv=False
   Exit Function
End If
'check whether time is outof range
Call checktime(byear.text,9999,0,"begin year")
Call checktime(bmonth.text,12,1,"begin month")
Call checktime(bday.text,31,1,"begin day")
Call checktime(bhour.text,23,0,"begin hour")
Call checktime(bmin.text,59,0,"begin minutes")
Call checktime(bsec.text,59,0,"begin second")

'check whether entered endtime is legal or valid
If Not IsNumeric(eyear.text)Or Not IsNumeric(emonth.text)Or Not IsNumeric(eday.text)Or Not _ 
       IsNumeric(ehour.text)Or Not IsNumeric(emin.text)Or Not IsNumeric(esec.text) Then
   MsgBox "some of you entered endtime is not numeric or null!",vbOKCancel,"wrong time"
   timeconv = False
   Exit Function
End If
'check whether time is outof range
Call checktime(eyear.text,9999,0,"end year")
Call checktime(emonth.text,12,1,"end month")
Call checktime(eday.text,31,1,"end day")
Call checktime(ehour.text,23,0,"end hour")
Call checktime(emin.text,59,0,"end minutes")
Call checktime(esec.text,59,0,"end second")

'check whether begin time is later than end time
btime= byear.text & "-" & bmonth.text &"-"& bday.text &" "& bhour.text &":"& bmin.text&":"&bsec.text
etime=eyear.text+"-"+emonth.text+"-"+eday.text+" "+ehour.text+":"+emin.text+":"+esec.text

timeerr = DateDiff("s",btime,etime)
If timeerr<0 Then
MsgBox"you entered wrong time range,begin time later than end time"
timeconv = False
Exit Function
End If
'check whether it is export time or show time,
'chioce=0--show Time,chioce=1---export Time
If choice = 0 Then
begintime = btime
endtime = etime
Else
'time convert to equalize with SQL server
If bhour.text >= 8 Then
    temph=CInt(bhour.text)-8
    tempd=DateDiff("d",0,btime)
Else
   temph=CInt(bhour.text)+16
   tempd=DateDiff("d",1,btime)
End If
   stemph=CStr(temph)
   stempd=CStr(CDate(tempd))

'new time after convert
   newbtime=stempd+" "+stemph+":"+bmin.text+":"+bsec.text
If ehour.text >= 8 Then
    temph=CInt(ehour.text)-8
    tempd=DateDiff("d",0,etime)
Else
   temph=CInt(ehour.text)+16
   tempd=DateDiff("d",1,etime)
End If
   stemph=CStr(temph)
   stempd=CStr(CDate(tempd))
'new time after convert
   newetime=stempd+" "+stemph+":"+emin.text+":"+esec.text
begintime =newbtime
endtime=newetime
End If 'end of chioce 
timeconv = True 
End Function

Sub checktime(input,upper,downer,note)
'check if time is outof ranges
If CInt(input)<downer Or CInt(input)>upper Then
MsgBox"you entered wrong range of " ¬e
Exit Sub
End If
End Sub

使用listview控件显示数据：

dim conn, rs, cmd, pstr,ssql
Dim opdlg,fm, ListView1,trend,item1
Dim m,n,b,s
dim begintime,endtime
b=timeconv(begintime,endtime,0)
'MsgBox CDate(begintime)
if b=false then
exit sub
else 
set conn = createobject("adodb.connection")
set rs = createobject("adodb.recordset")
set cmd = createobject("adodb.command")
Set opdlg = ScreenItems("dialog")
Set trend = ScreenItems("curve")

With opdlg 
.Flags = 4
.Filter = "MDB文件(*.mdb)|*.mdb|AllFiles(*.*)|*.*|"
.FilterIndex = 2
.InitDir = "E:\vb code"
.Action = 1
End With

If opdlg.FileName = "" Then
MsgBox "you must choose a file"
   Exit Sub
Else
fm = opdlg.FileName
End If
'MsgBox begintime
pstr = "Provider=Microsoft.Jet.OLEDB.4.0;"
pstr = pstr & "Data Source=" & fm
conn.connectionstring=pstr
conn.cursorlocation=3
conn.open
ssql="select * from MyTable where cdate(time) between #"&begintime&"# And #"&endtime&"#" 
rs.cursorlocation = 3
rs.open ssql,conn,1,2
m=rs.fields.count
'MsgBox ssql
Set ListView1 = ScreenItems("listview")
ListView1.ColumnHeaders.Clear
ListView1.ColumnHeaders.Add , , CStr(Rs.Fields(0).Name), 100
ListView1.ColumnHeaders.Add , , CStr(Rs.Fields(1).Name), 70
ListView1.ColumnHeaders.Add , , CStr(Rs.Fields(2).Name), 70
If (m > 0) Then
MsgBox "here"
Rs.MoveFirst
n = 0
s=rs.recordcount
MsgBox s
Do While Not Rs.EOF
n = n + 1
s = Left(CStr(Rs.Fields(0).Value), 23)
Set Item1 = ListView1.ListItems.Add()
Item1.Text = Left(CStr(Rs.Fields(0).Value), 23)
Item1.SubItems(1) = FormatNumber(Rs.Fields(1).Value, 1)
Item1.SubItems(2) = FormatNumber(Rs.Fields(2).Value, 1)
trend.index = 0
trend.Datax=CDate(rs.fields(0).value) 
trend.datay= rs.fields(1).value
trend.InsertData = True 
trend.index = 1
trend.Datax=CDate(rs.fields(0).value) 
trend.datay= rs.fields(2).value
trend.InsertData = True

If (n > 1000) Then Exit Do
Rs.MoveNext
Loop
Rs.Close
Else
End If
Set Rs = Nothing
conn.Close
Set conn = Nothing
end if 'end of b=true

使用wincc自带function trend控件显示曲线，使用复选框选择：

显示复选框与关闭
Sub X6309X94AE3X0000X79F0_OnLButtonDown(ByVal Item, ByVal Flags, ByVal x, ByVal y) 
Dim checkbo
Set checkbo=ScreenItems("checkbox")
checkbo.Visible= Not checkbo.Visible
End Sub
复选框的输入输出域改变时VBS脚本，选择曲线
Sub Process_OnPropertyChanged(ByVal Item, ByVal value)         
Dim curve, checkbo
Dim pp,i
Set curve= ScreenItems("curve")
Set checkbo=ScreenItems("checkbox")
pp=checkbo.Process 
For i=0 To 1
curve.Index=i
If (pp Mod 2)=1 Then
curve.ItemVisible=True 
Else 
curve.ItemVisible=False
End If
pp=Fix(pp/2)
Next

End Sub

提问者对于答案的评价：
谢谢你们的回答！