導出
??上一篇介紹了查詢的VBS腳本,導出到Excel的功能同樣也通過腳本來實現(xiàn),也需要連接數(shù)據(jù)缀去,查詢需要的數(shù)據(jù)。與查詢功能不同的是甸祭,導出功能是把數(shù)據(jù)寫入到Excel中缕碎,而不是顯示到ListView控件上。這里給“導出”按鈕的事件屬性——“鼠標動作”中添加VBS腳本池户。
1咏雌、查詢數(shù)據(jù)
??這部分和查詢的腳本一樣凡怎,連接數(shù)據(jù)庫,先比較日期赊抖,然后再通過查詢字符串進行查詢操作统倒。
'定義連接字符串
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獲取的為系統(tǒng)短時間格式 "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
' 創(chuàng)建查詢的命令文本
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變量用于返回有效記錄的數(shù)目
'MsgBox "查詢結(jié)果: 共有"& m &"條記錄"
2房匆、調(diào)用Excel模板
??先編輯好Excel模板,可根據(jù)自己的報表需求來設(shè)計模板报亩,這里模板保存在"D:\export_cardinfo\excel模板(勿刪)"文件夾中浴鸿,命名為“mode.xls”.
'調(diào)用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中填入數(shù)據(jù)
??通過Excel的接口打開模板后弦追,填入數(shù)據(jù)到Excel中岳链。
'填充數(shù)據(jù)到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 '是否到記錄末尾劲件,循環(huán)填寫表格
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 "沒有所需數(shù)據(jù)……"
item.Enabled = True
Set oRs = Nothing
conn.Close
Set conn = Nothing
objExcelApp.Workbooks.Close
objExcelApp.Quit
Set objExcelApp= Nothing
Exit Sub
End If
4掸哑、斷開數(shù)據(jù)庫連接,保存數(shù)據(jù)到新的Excel文件
??完成寫入數(shù)據(jù)到Excel后寇仓,需要先斷開數(shù)據(jù)庫举户,然后保存到新的Excel文件中。
'斷開數(shù)據(jù)庫
Set oRs = Nothing
conn.Close
Set conn = Nothing
??生成新的Excel文件遍烦,自定義文件名“filename”和存儲路徑“path”俭嘁,這里文件名以保存時間、查詢時間范圍來命名服猪。
'生成新的Excel文件供填,并關(guān)閉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畫面看看實際效果罢猪。