WinccVvbs读取多个变量归档数据到EXCEL修订稿

  • 格式:docx
  • 大小:57.51 KB
  • 文档页数:8

WinccVvbs读取多个变量归档数据到EXCEL

集团标准化工作小组 [Q8QX9QT-X8QQB8Q8-NQ8QJ8-M8QMN]

Winccvbs读取多个变量归档数据到excel

前面的一篇博客记录了如何读取多个变量归档数据到mshgrid控件,根据的是西门子官网的教学。有网友询问为什么他照着官网方法就是无法导出到excel。我自己也做了一遍,没有问题。本篇主要记录导出按钮的脚本。

前面的准备工作与上一篇一致,导出按钮的vbs脚本如下:

Sub OnClick(ByVal Item)

Dim myCatalog,myDS,PCName,cnstr,sqlstr1,sqlstr2

Dim xlapp,BTime,ETime,utcbtime,utcetime,utcbtstr,utcetstr

Dim conobj,rsobj1,comobj1

Dim rsobj2,comobj2

Dim rscount,i,curRow

Dim filename

myCatalog=("@DatasourceNameRT").Read

PCName=("@LocalMachineName").Read

myDS=PCName & "\Wincc"

Set BTime=("btime")

Set ETime=("etime")

'北京时间时区修正

utcbtime=Dateadd("h",-8, '起始时间

utcetime=Dateadd("h",-8, '结束时间

'日期时间格式修正

utcbtstr = Year(utcbtime) & "-" & Month(utcbtime) & "-" & Day(utcbtime) & " "

& Hour(utcbtime) & ":" & Minute(utcbtime) & ":" & Second(utcbtime)

utcetstr = Year(utcetime) & "-" & Month(utcetime) & "-" & Day(utcetime) & " "

& Hour(utcetime) & ":" & Minute(utcetime) & ":" & Second(utcetime)

'连接字符串

cnstr="Provider=; Catalog=" & myCatalog & "; Data Source=" &myDS

'创建连接对象

Set conobj=CreateObject("")

=cnstr

= 3

'查询字符串

'sqlstr = "Tag:R,('VA\flow1';'VA\flow2'),'" & utcbtstr & "','" & utcetstr &

"'," & "'order by Timestamp ASC','TimeStep=1,1'"

sqlstr1 = "Tag:R,('VA\flow1'),'" & utcbtstr & "','" & utcetstr & "'," &

"'order by Timestamp ASC','TimeStep=1,1'"

sqlstr2 = "Tag:R,('VA\flow2'),'" & utcbtstr & "','" & utcetstr & "'," &

"'order by Timestamp ASC','TimeStep=1,1'"

'进行查询

Set rsobj1 = CreateObject("")

Set comobj1 = CreateObject("")

= 1

Set = conobj

= sqlstr1

Set rsobj1 =

Set rsobj2 = CreateObject("")

Set comobj2 = CreateObject("")

= 1

Set = conobj

= sqlstr2

Set rsobj2 =

rscount=

if rscount=0 then

msgbox "没有记录"

exit sub

end if

Set xlapp=CreateObject("")

=False

'初始化excel

(1).cells(1,1)="编号:"

(1).cells(1,2)=""

(1).range("a2:c2").mergecells=True '合并单元格

(1).cells(2,1)="这是一个测试"

(1).cells(2,1).HorizontalAlignment = 3 '文字居中

(1).cells(3,1)="日期时间"

(1).cells(3,2)="flow1"

(1).cells(3,3)="flow2"

'导出到excel

For i=1 To rscount

(1).cells(3+i,1)=Dateadd("h",+8,(1).value)

(1).cells(3+i,2)=(2).value

(1).cells(3+i,3)=(2).value

Next

'释放资源

Set rsobj1 = Nothing

Set rsobj2 = Nothing

Set conobj = Nothing

'画边框

(1).range("a3:c" & CStr(3+rscount)).borders(1).linestyle=9

(1).range("a3:c" & CStr(2+rscount)).borders(1).weight=2

(1).range("a3:c" & CStr(2+rscount)).borders(2).linestyle=9

(1).range("a3:c" & CStr(2+rscount)).borders(2).weight=2

(1).range("a3:c" & CStr(2+rscount)).borders(3).linestyle=9

(1).range("a3:c" & CStr(2+rscount)).borders(3).weight=2

(1).range("a3:c" & CStr(2+rscount)).borders(4).linestyle=9

(1).range("a3:c" & CStr(2+rscount)).borders(4).weight=2

'保存文件

filename= "c:\" & Year(Now) & "年" & Month(Now) & "月" & Day(Now) & "日-" &

Hour(Now) & "点" & Minute(Now) & "分" & Second(Now) & "秒生成生产报表.xlsx"

(filename)

Msgbox "成功导出到C:\"

End Sub

无法导出数据的朋友,检查一下官网提示的那个连接包是否安装了。