WinCC 7.0 用户归档+Listview控件 制作报表（三）

---

导出

  上一篇介绍了查询的VBS脚本，导出到Excel的功能同样也通过脚本来实现，也需要连接数据，查询需要的数据。与查询功能不同的是，导出功能是把数据写入到Excel中，而不是显示到ListView控件上。这里给“导出”按钮的事件属性——“鼠标动作”中添加VBS脚本。

1、查询数据
  这部分和查询的脚本一样，连接数据库，先比较日期，然后再通过查询字符串进行查询操作。

'定义连接字符串
Dim sPro,sDsn,sSer,sCon
sPro = "Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=false;"
sDsn = "Initial Catalog=CC_test_17_12_18_11_29_28R;"
sSer = "Data Source=ADMIN-PC\WINCC"
sCon = sPro + sDsn + sSer

Dim date1,date2,D1,D2
Set D1=ScreenItems("DTP1")   'DTP1获取的为系统短时间格式 "2017/12/28 10:00:00"
Set D2=ScreenItems("DTP2")
date1 = Split(D1.value," ",-1,1)
date2 = Split(D2.value," ",-1,1)
Dim dt1,dt2
dt1 = CStr(date1(0))&" "&"00:00:00"
dt2 = CStr(date2(0))&" "&"23:59:59"
 
'比较两个日期得大小   
If DateDiff("d", CDate(D1.value), CDate(D2.value)) < 0 Then
   MsgBox "起始日期: "& date1(0) &"   大于  终止日期: "& date2(0), vbOKOnly + vbExclamation, "警告"
   Exit Sub
End If

'定义查询命令，查找符合条件的信息，位于两个日期之间的信息
Dim sSql
sSql = "select * from UA#test3 where act_time between '"& dt1 & "'" & "and '" & dt2 & "'"

'建立连接
Dim oRs,oCom,conn,m
Set conn = CreateObject("ADODB.Connection")
    conn.ConnectionString = sCon
    conn.CursorLocation = 3
    conn.Open

' 创建查询的命令文本
Set oRs = CreateObject("ADODB.Recordset")
Set oCom = CreateObject("ADODB.Command")
    oCom.CommandType = 1
Set oCom.ActiveConnection = conn
    oCom.CommandText = sSql
Set oRs = oCom.Execute
m = oRs.RecordCount    'm变量用于返回有效记录的数目
'MsgBox "查询结果: 共有"& m &"条记录"

2、调用Excel模板
  先编辑好Excel模板，可根据自己的报表需求来设计模板，这里模板保存在"D:\export_cardinfo\excel模板（勿删）"文件夹中，命名为“mode.xls”.

Excel模板

'调用Excel的接口打开模板
Dim objExcelApp,sheetname
sheetname="Sheet1"
Set objExcelApp=CreateObject("Excel.Application") 
objExcelApp.Visible=FALSE
objExcelApp.Workbooks.Open"D:\export_cardinfo\excel模板（勿删）\mode.xls"
objExcelApp.Worksheets(sheetname).Activate 

3、向Excel中填入数据
  通过Excel的接口打开模板后，填入数据到Excel中。

'填充数据到Excel中，
If (m > 0) Then
    objExcelApp.Worksheets(sheetname).cells(2,1).value="刷卡记录编号"
    objExcelApp.Worksheets(sheetname).cells(2,2).value="刷卡时间"
    objExcelApp.Worksheets(sheetname).cells(2,3).value="车号"
    oRs.MoveFirst
    Dim i
    i=3
    Do While Not oRs.EOF '是否到记录末尾，循环填写表格
        objExcelApp.Worksheets(sheetname).cells(i,1).value= CStr(oRs.Fields(0).Value)
        objExcelApp.Worksheets(sheetname).cells(i,2).value= CStr(oRs.Fields(3).Value)
        objExcelApp.Worksheets(sheetname).cells(i,3).value= CStr(oRs.Fields(4).Value)
        oRs.MoveNext
        i=i+1
    Loop
    oRs.Close
Else
    MsgBox "没有所需数据……"
    item.Enabled = True
    Set oRs = Nothing
    conn.Close
    Set conn = Nothing
    objExcelApp.Workbooks.Close
    objExcelApp.Quit
    Set objExcelApp= Nothing
    Exit Sub
End If

4、断开数据库连接，保存数据到新的Excel文件
  完成写入数据到Excel后，需要先断开数据库，然后保存到新的Excel文件中。

'断开数据库
Set oRs = Nothing
conn.Close
Set conn = Nothing

  生成新的Excel文件，自定义文件名“filename”和存储路径“path”，这里文件名以保存时间、查询时间范围来命名。

'生成新的Excel文件，并关闭Excel
Dim patch,filename,da1,da2,da3,da4
da1=Split(date1(0),"/",-1,1)
da2=Split(date2(0),"/",-1,1)
da3=CStr(da1(0))&CStr(da1(1))&CStr(da1(2))
da4=CStr(da2(0))&CStr(da2(1))&CStr(da2(2))
filename="1#机记录"&CStr(Year(Now))&CStr(Month(Now))&CStr(Day(Now))&CStr(Hour(Now))&CStr(Minute(Now))&CStr(Second(Now))&"_("& da3 &"-"& da4&")"
patch= "D:\export_cardinfo\"&filename&".xls"
objExcelApp.ActiveWorkbook.SaveAs patch
objExcelApp.Workbooks.Close   
objExcelApp.Quit 
MsgBox "刷卡记录已导出到 D:\export_cardinfo 文件夹"

  这样就完成了导出到Excel功能的脚本，同样运行WinCC画面看看实际效果。

导出到Excel