内容发布更新时间 : 2025/2/26 0:31:32星期一 下面是文章的全部内容请认真阅读。

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(\PCName=HMIRuntime.Tags(\myDS=PCName& \

Set BTime=HMIRuntime.Tags(\Set ETime=HMIRuntime.Tags(\

'北京时间时区修正

utcbtime=Dateadd(\起始时间 utcetime=Dateadd(\结束时间 '日期时间格式修正

utcbtstr = Year(utcbtime) & \& \

utcetstr = Year(utcetime) & \& \

'连接字符串

cnstr=\'创建连接对象

Set conobj=CreateObject(\conobj.connectionstring=cnstr conobj.CursorLocation = 3 conobj.Open '查询字符串

'sqlstr = \sqlstr1 = \sqlstr2 = \

'进行查询

Set rsobj1 = CreateObject(\Set comobj1 = CreateObject(\comobj1.CommandType = 1

Set comobj1.ActiveConnection = conobj comobj1.CommandText = sqlstr1 Set rsobj1 = comobj1.Execute

Set rsobj2 = CreateObject(\Set comobj2 = CreateObject(\comobj2.CommandType = 1

Set comobj2.ActiveConnection = conobj comobj2.CommandText = sqlstr2 Set rsobj2 = comobj2.Execute rscount=rsobj1.recordcount rsobj1.movefirst rsobj2.movefirst ifrscount=0 then

msgbox \没有记录\ exit sub end if

Set xlapp=CreateObject(\xlapp.visible=False xlapp.workbooks.add

'初始化excel

xlapp.worksheets(1).cells(1,1)=\编号：\

xlapp.worksheets(1).cells(1,2)=\

xlapp.worksheets(1).range(\合并单元格 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)=\xlapp.worksheets(1).cells(3,3)=\

'导出到excel For i=1 To rscount

xlapp.worksheets(1).cells(3+i,1)=Dateadd(\ 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(\xlapp.worksheets(1).range(\xlapp.worksheets(1).range(\xlapp.worksheets(1).range(\xlapp.worksheets(1).range(\xlapp.worksheets(1).range(\xlapp.worksheets(1).range(\xlapp.worksheets(1).range(\'保存文件

filename= \年\月\日-\点\分\秒生成生产报表.xlsx\xlapp.Activeworkbook.saveas (filename)

xlapp.workbooks.close xlapp.quit

Msgbox \成功导出到C:\\\

End Sub

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