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

使用VBS读取变量归档数据到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("https://www.360docs.net/doc/bc16163955.html,mand")

https://www.360docs.net/doc/bc16163955.html,mandType = 1

Set oCom.ActiveConnection = conn

https://www.360docs.net/doc/bc16163955.html,mandText = 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表格，表格内容如下：