'变量定义和初始化
'打开excel模板
'准备查询条件
'主要是确定和格式化Catalog、UTC开始时间、UTC结束时间、时间间隔等查询条件。因为北京'时间和UTC（协调世界时）时间相差8个小时，所以直接在程序中写入固定的时间差值
'
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
'创建数据库联接
Dim str
Dim con
Dim sql
Set con=CreateObject("ADODB.Connection")
str="rovider=SQLOLEDB.1;Data Source =GMK-PC\WINCC;Initial Catalog =" &tagDSNName.Value& ";UID=abcd
con.ConnectionString=str
con.Open
'定义查询的命令文本 SQL
sSql = "Tag:R,('PVArchive\NewTag'),'" & UTCBeginTime & "','" & UTCEndTime & "',"
sSql=sSql+"'order by Timestamp ASC','TimeStep=" & sVal.Value & ",1'"
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