在wincc中如何使用VBS读取变量归档数据到Excel

'此为查询按钮中的代码 '变量定义和初始化 Dim sPro,sDsn,sSer,sCon,conn,sSql,oRs,oCom Dim tagDSNName Dim m,i Dim LocalBeginTime, LocalEndTime,UTCBeginTime, UTCEndTime,sVal Dim objExcelApp,objExcelBook,objExcelSheet,sheetname item.Enabled = False On Error Resume Next sheetname="Sheet1" '打开Excel模板 Set objExcelApp = CreateObject("Excel.Application") objExcelApp.Visible = False objExcelApp.Workbooks.Open "D:\WinCCWriteExcel\abc.xlsx" objExcelApp.Worksheets(sheetname).Activate '准备查询条件 Catalog、UTC开始时间、UTC结束时间、时间间隔 Set tagDSNName = HMIRuntime.Tags("@DatasourceNameRT") tagDSNName.Read Set LocalBeginTime = HMIRuntime.Tags("strBeginTime") LocalBeginTime.Read Set LocalEndTime = HMIRuntime.Tags("strEndTime") LocalEndTime.Read UTCBeginTime = DateAdd("h" ,-8,LocalBeginTime.Value) UTCEndTime= DateAdd("h" ,-8,LocalEndTime.Value) UTCBeginTime = Year(UTCBeginTime) & "-" & Month(UTCBeginTime) & "-" & Day(UTCBeginTime) & " " & Hour(UTCBeginTime) & ":" & Minute(UTCBeginTime) & ":" & Second(UTCBeginTime) UTCEndTime = Year(UTCEndTime) & "-" & Month(UTCEndTime) & "-" & Day(UTCEndTime) & " " & Hour(UTCEndTime) & ":" & Minute(UTCEndTime) & ":" & Second(UTCEndTime) HMIRuntime.Trace "UTC Begin Time: " & UTCBeginTime & vbCrLf HMIRuntime.Trace "UTC end Time: " & UTCEndTime & vbCrLf Set sVal = HMIRuntime.Tags("sVal") sVal.Read '创建数据库联接 sPro = "Provider=WinCCOLEDBProvider.1;" sDsn = "Catalog=" &tagDSNName.Value& ";" sSer = "Data Source=.\WinCC" sCon = sPro + sDsn + sSer Set conn = CreateObject("ADODB.Connection") conn.ConnectionString = sCon conn.CursorLocation = 3 conn.Open '定义查询的命令文本 SQL 'sSql = "Tag:R,('PVArchive\NewTag'),'" & UTCBeginTime & "','" & UTCEndTime & "'" 'sSql = "Tag:R,('PVArchive\NewTag'),'0000-00-00 00:10:00.000','0000-00-00 00:00:00.000'" 'sSql = "Tag:R,('PVArchive\NewTag';'PVArchive\NewTag_1'),'" & UTCBeginTime & "','" & UTCEndTime & "'," 'sSql = "Tag:R,('PVArchive\NewTag'),'" & UTCBeginTime & "','" & UTCEndTime & "','order by Timestamp DESC','TimeStep=" & sVal.Value & ",1" sSql = "Tag:R,('PVArchive\NewTag'),'" & UTCBeginTime & "','" & UTCEndTime & "'," sSql=sSql+"'order by Timestamp ASC','TimeStep=" & sVal.Value & ",1'" MsgBox sSql Set oRs = CreateObject("ADODB.Recordset") Set oCom = CreateObject("ADODB.Command") oCom.CommandType = 1 Set oCom.ActiveConnection = conn oCom.CommandText = sSql '填充数据到Excel中 Set oRs = oCom.Execute m = oRs.RecordCount If (m > 0) Then objExcelApp.Worksheets(sheetname).cells(2,1).value=oRs.Fields(0).Name objExcelApp.Worksheets(sheetname).cells(2,2).value=oRs.Fields(1).Name objExcelApp.Worksheets(sheetname).cells(2,3).value=oRs.Fields(2).Name objExcelApp.Worksheets(sheetname).cells(2,4).value=oRs.Fields(3).Name objExcelApp.Worksheets(sheetname).cells(2,5).value=oRs.Fields(4).Name oRs.MoveFirst i=3 Do While Not oRs.EOF '是否到记录末尾，循环填写表格 objExcelApp.Worksheets(sheetname).cells(i,1).value= oRs.Fields(0).Value objExcelApp.Worksheets(sheetname).cells(i,2).value= GetLocalDate(oRs.Fields(1).Value) objExcelApp.Worksheets(sheetname).cells(i,3).value= oRs.Fields(2).Value objExcelApp.Worksheets(sheetname).cells(i,4).value= oRs.Fields(3).Value objExcelApp.Worksheets(sheetname).cells(i,5).value= oRs.Fields(4).Value oRs.MoveNext i=i+1 Loop oRs.Close Else MsgBox "没有所需数据……" item.Enabled = True Set oRs = Nothing conn.Close Set conn = Nothing objExcelApp.Workbooks.Close objExcelApp.Quit Set objExcelApp= Nothing Exit Sub End If '释放资源 Set oRs = Nothing conn.Close Set conn = Nothing '生成新的文件,关闭Excel Dim patch,filename filename=CStr(Year(Now))&CStr(Month(Now))&CStr(Day(Now))&CStr(Hour(Now))+CStr(Minute(Now))&CStr(Second(Now)) patch= "d:\"&filename&"demo.xlsx" objExcelApp.ActiveWorkbook.SaveAs patch objExcelApp.Workbooks.Close objExcelApp.Quit Set objExcelApp= Nothing MsgBox "成功生成数据文件!" item.Enabled = True