WINCC+VBS+ADO访问归档数据（V6.2测试通过）

Sub OnLButtonDown(ByVal Item, ByVal Flags, ByVal x, ByVal y)                                                 
Dim oList
Dim obj
Dim constr
Dim oRs
Dim objCom
Dim comstr
Dim m
Dim n
Dim oItem
Dim s
Dim k
Set oList=ScreenItems("控件5")
oList.View=3
oList.ListItems.Clear
Set obj=CreateObject("ADODB.Connection")
obj.CursorLocation=3
obj.Open "Provider=WinCCOLEDBProvider.1; Catalog=CC_TEST_WIN_10_08_02_17_29_24R;Data Source=.\WINCC"
Set oRs=CreateObject("ADODB.Recordset")
Set objCom=CreateObject("ADODB.Command")
comstr="TAG:R,'ProcessValueArchive\NewTag','2008-08-14 1:36:20','2008-08-14 1:44:20'"
Set objCom.ActiveConnection=obj
objCom.CommandText=comstr
Set oRs= objCom.Execute
m=oRs.Fields.Count
With oList
.ColumnHeaders.Clear
.ColumnHeaders.Add , , CStr(oRs.Fields(1).Name), 780
.ColumnHeaders.Add , , CStr(oRs.Fields(2).Name), 900
.ColumnHeaders.Add , , CStr(oRs.Fields(3).Name), 1050
.ColumnHeaders.Add , , CStr(oRs.Fields(4).Name), 1200
End With
If (m > 0) Then
oRs.MoveFirst

Do While Not oRs.EOF

 

's = Left(CStr(oRs.Fields(1).value), 23)
s = CDate(oRs.Fields(1).value)

k = DateAdd("h", 8, s)

Set oItem = oList.ListItems.Add    'ListItem 代表一行

oItem.Text = k  '第I行的行第一列
oItem.SubItems(1) = FormatNumber(oRs.Fields(2).value, 1) '第I行的行第二列
oItem.SubItems(2) = Hex(oRs.Fields(3).value) '第I行的行第三列
oItem.SubItems(3) = FormatNumber(oRs.Fields(4).value, 1) '第I行的行第四列

oRs.MoveNext
Loop
oRs.Close
Else
End If
Set oRs = Nothing
Set obj=Nothing
Set objCom=Nothing
obj.Close
Set obj=Nothing