Sub OnClick(ByVal Item)
Dim sDsn
Dim sSer
Dim sCon
Dim sSql
Dim conn
Dim oRs
Dim oCom
Dim sPro
Dim m,n,s
Dim a,b,c
Dim Listview1
Dim oItem
Dim strDateTime
Dim iMS
Set Listview1 = ScreenItems("Control1")
Dim TimeFrom
Dim TimeTo
Set TimeFrom= HMIRuntime.Tags("TimeFrom")
TimeFrom.Read
Set TimeTo= HMIRuntime.Tags("TimeTo")
TimeTo.Read
sPro = "Provider=WinCCOLEDBProvider.1;"
sDsn = "Catalog=CC_accessme_08_08_14_20_08_46R;"
sSer = "Data Source=.\WinCC"
sCon = sPro + sDsn + sSer
'sSql = "Tag:R,'ProcessValueArchive\tag1','2008-08-14 07:32:00.000','2008-08-15 07:34:00.000'"
sSql = "Tag:R,'ProcessValueArchive\tag1','" + TimeFrom.Value + "','" + TimeTo.Value + "'"
MsgBox "Open with:" & vbCr & sCon & vbCr & sSql & vbCr
Set conn = CreateObject("ADODB.Connection")
conn.ConnectionString = sCon
conn.CursorLocation = 3
conn.Open
Set oRs = CreateObject("ADODB.Recordset")
Set oCom = CreateObject("ADODB.Command")
oCom.CommandType = 1
Set oCom.ActiveConnection = conn
oCom.CommandText = sSql
Set oRs = oCom.Execute
m = oRs.Fields.Count
If (m > 0) Then
oRs.MoveFirst
ListView1.ColumnHeaders.Clear
ListView1.ColumnHeaders.Add , , CStr(oRs.Fields(1).Name), 200 ' DateTime
ListView1.ColumnHeaders.Add , , "MS", 100 ' Milisecond
ListView1.ColumnHeaders.Add , , CStr(oRs.Fields(0).Name), 100 ' DateTime
ListView1.ColumnHeaders.Add , , CStr(oRs.Fields(2).Name), 100 ' DateTime
ListView1.ColumnHeaders.Add , , CStr(oRs.Fields(3).Name), 80 ' DateTime
ListView1.ColumnHeaders.Add , , CStr(oRs.Fields(4).Name), 50 ' DateTime
Do While Not oRs.EOF
SplitDateTimeAndMs oRs.Fields(1).Value, strDateTime, iMS 'Split Milisecond from DateTime
s = FormatDateTime(strDateTime, 2) & " " & FormatDateTime(strDateTime, 3)
Set oItem = ListView1.ListItems.Add()
oItem.Text = s
oItem.SubItems(1) = iMS
oItem.SubItems(2) = oRs.Fields(0).Value
oItem.SubItems(3) = FormatNumber(oRs.Fields(2).Value, 2)
oItem.SubItems(4) = Hex(oRs.Fields(3).Value)
oItem.SubItems(4) = Hex(oRs.Fields(3).Value)
oRs.MoveNext
Loop
End If
oRs.Close
Set oRs = Nothing
conn.Close
Set conn = Nothing
End Sub
