WinccV7.3vbs读取多个变量归档数据到excel前面的一篇博客记录了如何读取多个变量归档数据到mshgrid控件,根据的是西门子官网的教学。有网友询问为什么他照着官网方法就是无法导出到excel。我自己也做了一遍,没有问题。本篇主要记录导出按钮的脚本。前面的准备工作与上一篇一致,导出按钮的vbs脚本如下:SubOnClick(ByValItem)DimmyCatalog,myDS,PCName,cnstr,sqlstr1,sqlstr2Dimxlapp,BTime,ETime,utcbtime,utcetime,utcbtstr,utcetstrDimconobj,rsobj1,comobj1Dimrsobj2,comobj2Dimrscount,i,curRowDimfilenamemyCatalog=HMIRuntime.Tags(@DatasourceNameRT).ReadPCName=HMIRuntime.Tags(@LocalMachineName).ReadmyDS=PCName&\WinccSetBTime=HMIRuntime.Tags(btime)SetETime=HMIRuntime.Tags(etime)'北京时间时区修正utcbtime=Dateadd(h,-8,BTime.Read)'起始时间utcetime=Dateadd(h,-8,ETime.Read)'结束时间'日期时间格式修正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;Catalog=&myCatalog&;DataSource=&myDS'创建连接对象Setconobj=CreateObject(ADODB.Connection)conobj.connectionstring=cnstrconobj.CursorLocation=3conobj.Open'查询字符串'sqlstr=Tag:R,('VA\flow1';'VA\flow2'),'&utcbtstr&','&utcetstr&',&'orderbyTimestampASC','TimeStep=1,1'sqlstr1=Tag:R,('VA\flow1'),'&utcbtstr&','&utcetstr&',&'orderbyTimestampASC','TimeStep=1,1'sqlstr2=Tag:R,('VA\flow2'),'&utcbtstr&','&utcetstr&',&'orderbyTimestampASC','TimeStep=1,1''进行查询Setrsobj1=CreateObject(ADODB.Recordset)Setcomobj1=CreateObject(ADODB.Command)comobj1.CommandType=1Setcomobj1.ActiveConnection=conobjcomobj1.CommandText=sqlstr1Setrsobj1=comobj1.ExecuteSetrsobj2=CreateObject(ADODB.Recordset)Setcomobj2=CreateObject(ADODB.Command)comobj2.CommandType=1Setcomobj2.ActiveConnection=conobjcomobj2.CommandText=sqlstr2Setrsobj2=comobj2.Executerscount=rsobj1.recordcountrsobj1.movefirstrsobj2.movefirstifrscount=0thenmsgbox没有记录exitsubendifSetxlapp=CreateObject(Excel.Application)xlapp.visible=Falsexlapp.workbooks.add'初始化excelxlapp.worksheets(1).cells(1,1)=编号:xlapp.worksheets(1).cells(1,2)=QB-2017.001xlapp.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)=flow1xlapp.worksheets(1).cells(3,3)=flow2'导出到excelFori=1Torscountxlapp.worksheets(1).cells(3+i,1)=Dateadd(h,+8,rsobj1.fields(1).value)xlapp.worksheets(1).cells(3+i,2)=rsobj1.fields(2).valuexlapp.worksheets(1).cells(3+i,3)=rsobj2.fields(2).valuersobj1.movenextrsobj2.movenextNext'释放资源Setrsobj1=NothingSetrsobj2=Nothingconobj.CloseSetconobj=Nothing'画边框xlapp.worksheets(1).range(a3:c&CStr(3+rscount)).borders(1).linestyle=9xlapp.worksheets(1).range(a3:c&CStr(2+rscount)).borders(1).weight=2xlapp.worksheets(1).range(a3:c&CStr(2+rscount)).borders(2).linestyle=9xlapp.worksheets(1).range(a3:c&CStr(2+rscount)).borders(2).weight=2xlapp.worksheets(1).range(a3:c&CStr(2+rscount)).borders(3).linestyle=9xlapp.worksheets(1).range(a3:c&CStr(2+rscount)).borders(3).weight=2xlapp.worksheets(1).range(a3:c&CStr(2+rscount)).borders(4).linestyle=9xlapp.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)&秒生成生产报表.xlsxxlapp.Activeworkbook.saveas(filename)xlapp.workbooks.closexlapp.quitMsgbox成功导出到C:\EndSub无法导出数据的朋友,检查一下官网提示的那个连接包是否安装了。