之前做項目的時候,查閱了大量資料,終于解決了將歸檔數(shù)據(jù)導(dǎo)出到excel的功能,這里將我的代碼發(fā)出來以供參考。注意,里面的一些參數(shù)需要根據(jù)你的具體需要進(jìn)行修改。
本人還總結(jié)了一份技術(shù)文檔,由于這里不能上傳上傳文檔,請到我的個人博客里下載吧:
http://www.ucooper.com/wincc-summary.htmlSub OnLButtonDown(ByVal Item, ByVal Flags, ByVal x, ByVal y)
Dim sPro,sDsn,sSer,sCon,sSql,oRs,conn,oCom,oItem,m,n,s,i,hourdate,secdate
Dim k,oList,objExcelApp,oItem2,dt1,dt2,dstr1,dstr2,dstr3,dstr4
sPro = "Provider=WinCCOLEDBProvider.1;"
sDsn = "Catalog=CC_tanks_09_07_14_10_38_56R;" '根據(jù)實際情況修改,查SQLSERVER
sSer = "Data Source=.\WinCC"
sCon = sPro + sDsn + sSer
sSql = "TAG:R,'tanks\aa','2009-07-16 12:30:00.000','2009-07-16 13:00:00.000'" 'tanks是歸檔名 aa 是變量名
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
n=oRs.RecordCount
MsgBox(n)
'oRs.MoveFirst
Set objexcelApp=CreateObject("excel.application")
objexcelApp.visible=True
objexcelapp.workbooks.open"d:\book.xls" '首先要創(chuàng)建這個文件
objExcelApp.Sheets(1).Range("a"&Trim(1)) =oRs.Fields(0).Name
objExcelApp.Sheets(1).Range("b"&Trim(1)) = oRs.Fields(1).Name
objExcelApp.Sheets(1).Range("c"&Trim(1)) = oRs.Fields(2).Name
objExcelApp.Sheets(1).Range("d"&Trim(1)) = oRs.Fields(3).Name
objExcelApp.Sheets(1).Range("e"&Trim(1)) = oRs.Fields(4).Name
For i=1 To oRs.RecordCount
'NewDate = DateAdd("h", 8, "FormatNumber(oRs.Fields(1).value, 1)")
objExcelApp.Sheets(1).Range("a"&Trim(i+1)) =oRs.Fields(0).value
objExcelApp.Sheets(1).Range("b"&Trim(i+1)) =DateAdd("h",+8,oRs.Fields(1).value)
objExcelApp.Sheets(1).Range("c"&Trim(i+1)) =oRs.Fields(2).value
objExcelApp.Sheets(1).Range("d"&Trim(i+1)) =oRs.Fields(3).value
objExcelApp.Sheets(1).Range("e"&Trim(i+1)) =oRs.Fields(4).value
oRs.MoveNext
Next
oRs.Close
Set oRs = Nothing
conn.Close
Set conn = Nothing
objexcelapp.activeworkbook.save
objexcelapp.workbooks.close
'Set objexcelapp.workbooks=Nothing
objexcelapp.quit
MsgBox("aa")
Set objexcelapp=Nothing
MsgBox("bb")
MsgBox("導(dǎo)出成功!!")
End Sub