我找了一段程序,与《WINCC深入浅出》程序相似,读WINCC 归档到SQL里面的数据,但是对连接的那部分程序理解不深入,发现程序运行到
“Set oRs = oCom.Execute
MsgBox("OK2") ”
就无法运行了,论坛上看到有人遇到了相似的问题,但是没有最终的就绝办法。现将程序贴出:
Sub OnClick(ByVal Item)
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 = "CC_eastcity_10_12_20_19_23_59R;" '根据实际情况修改,查 SQLSERVER 得到CC_eastcity_10_12_20_19_23_59R
sSer = "Data Source=.\WinCC"
sCon = sPro + sDsn + sSer
sSql = "TAG:R,'ProcessValueArchive\LIT2A04','2010-12-20 11:26:00.000','2010-12-20 14:00:00.000'" 'ProcessValueArchive是归档名 LIT2A04 是变量名
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
MsgBox("OK1")
Set oRs = oCom.Execute
MsgBox("OK2")
n=oRs.RecordCount
MsgBox(n)
'oRs.MoveFirst
Set objexcelApp=CreateObject("excel.application")
objexcelApp.visible=True
objexcelapp.workbooks.open"D:\2010122010833.xlsx" '首先要创建这个文件
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("OK3")
Set objexcelapp=Nothing
MsgBox("OK4")
MsgBox("导出成功!!")
End Sub
到MsgBox("OK2") 无法运行,所以后面的还无法检测,是我的链接有问题吗?