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
无法导出数据的朋友,检查一下官网提示的那个连接包是否安装了。