代码如下,也是在论坛里找的,整理了一下,可以用现贴出来参考一下
Dim xlsApp
Dim sDsn
Dim sSer
Dim sCon
Dim sSql,sSq2,sSq3
Dim conn
Dim oRs1,oRs2,oRs3
Dim oCom
Dim sPro
Dim a,b
Dim m,n,s
Dim k
a = DateAdd("h",-8,ScreenItems("输入输出域1").OutputValue)
b = DateAdd("h",-8,ScreenItems("输入输出域2").OutputValue)
sPro = "Provider=WinCCOLEDBProvider.1;"
sDsn = "Catalog=CC_BBDC_08_05_21_20_46_09R;"
sSer = "Data Source=.\WinCC"
sCon = sPro + sDsn + sSer
sSql = "TAG:R,(182;183;181),"&a&","&b&""
sSq2 = "TAG:R,(180;179;178),"&a&","&b&""
sSq3 = "TAG:R,(177;176;175),"&a&","&b&""
Set conn = CreateObject("ADODB.Connection")
conn.ConnectionString = sCon
conn.CursorLocation = 3
conn.Open
Set oCom = CreateObject("ADODB.Command")
oCom.CommandType = 1
Set oCom.ActiveConnection = conn
oCom.CommandText = sSql
Set oRs1 = CreateObject("ADODB.Recordset")
Set oRs1 = oCom.Execute
Set xlsApp=CreateObject("Excel.Application")
xlsApp.Visible=True
xlsApp.Workbooks.Open"D:\sample.xls"
m = oRs1.Fields.Count
If (m > 0) Then
oRs1.MoveFirst
n =1
Do While oRs1("ValueID")=182
n = n + 1
xlsApp.Cells(n,1).Value=DateAdd("h",8,oRs1.Fields(1).Value)
xlsApp.Cells(n,2).Value=oRs1.Fields(2).Value
oRs1.MoveNext
Loop
n =1
Do While oRs1("ValueID")=183
n = n + 1
xlsApp.Cells(n,3).Value=oRs1.Fields(2).Value
oRs1.MoveNext
Loop
n =1
Do While Not oRs1.EOF
n = n + 1
xlsApp.Cells(n,4).Value=oRs1.Fields(2).Value
oRs1.MoveNext
Loop
End If
oRs1.Close
Set oRs1 = Nothing
oCom.CommandText = sSq2
Set oRs2 = CreateObject("ADODB.Recordset")
Set oRs2 = oCom.Execute
s = oRs2.Fields.Count
If (s > 0) Then
oRs2.MoveFirst
n =15
Do While oRs2("ValueID")=180
n = n + 1
xlsApp.Cells(n,1).Value=DateAdd("h",8,oRs2.Fields(1).Value)
xlsApp.Cells(n,2).Value=oRs2.Fields(2).Value
oRs2.MoveNext
Loop
n =15
Do While oRs2("ValueID")=179
n = n + 1
xlsApp.Cells(n,3).Value=oRs2.Fields(2).Value
oRs2.MoveNext
Loop
n =15
Do While Not oRs2.EOF
n = n + 1
xlsApp.Cells(n,4).Value=oRs2.Fields(2).Value
oRs2.MoveNext
Loop
End If
oRs2.Close
Set oRs2 = Nothing
oCom.CommandText = sSq3
Set oRs3 = CreateObject("ADODB.Recordset")
Set oRs3 = oCom.Execute
k = oRs3.Fields.Count
If (k > 0) Then
oRs3.MoveFirst
n =25
Do While oRs3("ValueID")=177
n = n + 1
xlsApp.Cells(n,1).Value=DateAdd("h",8,oRs3.Fields(1).Value)
xlsApp.Cells(n,2).Value=oRs3.Fields(2).Value
oRs3.MoveNext
Loop
n =25
Do While oRs3("ValueID")=176
n = n + 1
xlsApp.Cells(n,3).Value=oRs3.Fields(2).Value
oRs3.MoveNext
Loop
n =25
Do While Not oRs3.EOF
n = n + 1
xlsApp.Cells(n,4).Value=oRs3.Fields(2).Value
oRs3.MoveNext
Loop
End If
oRs3.Close
Set oRs3 = Nothing
xlsApp.ActiveWorkBook.Save
xlsApp.Workbooks.Close
xlsApp.Quit
Set xlsApp=Nothing
conn.Close
Set conn = Nothing