WinccV7.3vbs读取多个变量归档数据到excel
Wincc V7.3 vbs 读取多个变量归档数据到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=HMIRuntime.Tags(\"@DatasourceNameRT\").Read
PCName=HMIRuntime.Tags(\"@LocalMachineName\").Read myDS=PCName& \"\\Wincc\"
Set BTime=HMIRuntime.Tags(\"btime\") Set ETime=HMIRuntime.Tags(\"etime\") '北京时间时区修正
utcbtime=Dateadd(\"h\起始时间 utcetime=Dateadd(\"h\结束时间 '日期时间格式修正
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=WinCCOLEDBProvider.1; &myCatalog& \"; Data Source=\" & myDS
'创建连接对象
Set conobj=CreateObject(\"ADODB.Connection\") conobj.connectionstring=cnstr conobj.CursorLocation = 3 conobj.Open '查询字符串
'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(\"ADODB.Recordset\") Set
comobj1
=
CreateObject(\"http://www..com/doc/c917254907.html,mand\")
http://www..com/doc/c917254907.html,mandType = 1 Set comobj1.ActiveConnection = conobj
http://www..com/doc/c917254907.html,mandText = sqlstr1 Set rsobj1 = comobj1.Execute
Set rsobj2 = CreateObject(\"ADODB.Recordset\") Set
comobj2
=
CreateObject(\"http://www..com/doc/c917254907.html,mand\")
http://www..com/doc/c917254907.html,mandType = 1 Set comobj2.ActiveConnection = conobj
http://www..com/doc/c917254907.html,mandText = sqlstr2
Catalog=\"
Set rsobj2 = comobj2.Execute rscount=rsobj1.recordcount rsobj1.movefirst rsobj2.movefirst ifrscount=0 then msgbox \"没有记录\" exit sub end if
Set xlapp=CreateObject(\"Excel.Application\") xlapp.visible=False xlapp.workbooks.add '初始化excel
xlapp.worksheets(1).cells(1,1)=\"编号：\" xlapp.worksheets(1).cells(1,2)=\"QB-2017.001\"
xlapp.worksheets(1).range(\"a2:c2\").mergecells=True '合并单元格
xlapp.worksheets(1).cells(2,1)=\"这是一个测试\"
xlapp.worksheets(1).cells(2,1).HorizontalAlignment = 3 '文字居中
xlapp.worksheets(1).cells(3,1)=\"日期时间\" xlapp.worksheets(1).cells(3,2)=\"flow1\" xlapp.worksheets(1).cells(3,3)=\"flow2\" '导出到excel For i=1 To rscount
xlapp.worksheets(1).cells(3+i,1)=Dateadd(\"h\s(1).value)
xlapp.worksheets(1).cells(3+i,2)=rsobj1.fields(2).value xlapp.worksheets(1).cells(3+i,3)=rsobj2.fields(2).value rsobj1.movenext rsobj2.movenext
Next '释放资源
Set rsobj1 = Nothing Set rsobj2 = Nothing conobj.Close
Set conobj = Nothing '画边框
xlapp.worksheets(1).range(\"a3:c\" &CStr(3+rscount)).borders(1).linestyle=9
xlapp.worksheets(1).range(\"a3:c\" &CStr(2+rscount)).borders(1).weight=2
xlapp.worksheets(1).range(\"a3:c\" &CStr(2+rscount)).borders(2).linestyle=9
xlapp.worksheets(1).range(\"a3:c\" &CStr(2+rscount)).borders(2).weight=2
xlapp.worksheets(1).range(\"a3:c\" &CStr(2+rscount)).borders(3).linestyle=9
xlapp.worksheets(1).range(\"a3:c\" &CStr(2+rscount)).borders(3).weight=2
xlapp.worksheets(1).range(\"a3:c\" &CStr(2+rscount)).borders(4).linestyle=9
xlapp.worksheets(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\"
xlapp.Activeworkbook.saveas (filename) xlapp.workbooks.close xlapp.quit
Msgbox \"成功导出到C:\\\" End Sub
无法导出数据的朋友，检查一下官网提示的那个连接包是否安装了。
