使用VB将变量记录中的数据写入EXCEL

1、创建变量。过程归档变量、查询时间变量（一个起始时间、一个结束时间、时间间隔）

过程变量为模拟量，其实时间和结束时间是文本变量8位字符集（时间的格式是XXXX-XX-XX XX:XX:XX），时间间隔位10进制数（单位秒）

2、创建归档。变量记录中选择好要记录的过程变量，设置好归档的时间等。

3、创建EXCEL表格模版，XXX.XLSX.

4、界面上3个输入输入输出域（一个起始时间，一个结束时间，一个时间间隔），一个查询并生成EXCEL表格的按钮

5、脚本主要分2块。1是时间的转换，WINCC归档使用的时间是UTC（国际协调时间），所以需要进行时间的转换。2是查询并生成EXCEL表格的脚本。

6、过程值归档的记录结构如下：

脚本见文本文档

'查询按钮中的代码（按钮）

Sub OnLButtonUp(ByVal Item, ByVal Flags, ByVal x, ByVal y)   

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"

    Set objExcelApp = CreateObject("Excel.Application")

        objExcelApp.Visible = False

        objExcelApp.Workbooks.Open "D:\\WinCCWriteExcel\\abc.xlsx"

        objExcelApp.Worksheets(sheetname).Activate

    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

    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

    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

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

End Sub

时间转换脚本 （全局）

Function GetLocalDate(vtDate)

Dim DoY

Dim dso

Dim dwi

Dim strComputer, objWMIService, colItems, objItem

Dim TimeZone

Dim vtDateLocalDate

strComputer = "."

Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\\\" & strComputer & "\\root\\cimv2")

Set colItems = objWMIService.ExecQuery("Select * from Win32_TimeZone")

For Each objItem In colItems

    TimeZone = objItem.Bias / 60

Next

If IsDate(vtDate) <> True Then

  IS_GetLocalDate = False

  Exit Function

End If

DoY = DatePart("y", vtDate)

dso = DatePart("y", "31.03") - DatePart("w", "31.03") + 1

dwi = DatePart("y", "31.10") - DatePart("w", "31.10") + 1

If DoY >= dso And DoY < dwi Then

  TimeZone = TimeZone + 1

End If

vtDateLocalDate = DateAdd("h", 1 * TimeZone, vtDate)

GetLocalDate = vtDateLocalDate

End Function

实验成功后将在指定的位置创建EXCEL表格，表格内容如下：