导出
上一篇介绍了查询的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
