代码我已经写完了,两个datetimepicker也已经建立了,分别是控件1和控件2,麻烦大家帮我看下哪有问题,本人VB不怎么会
'变量定义和初始化
Dim sPro,sDsn,sSer,sCon,conn,sSql,oRs,oCom
Dim tagDSNName
Dim m,i
Dim DTPicker1,DTPicker2
Dim objExcelApp,objExcelBook,objExcelSheet,sheetname
Set DTPicker1 = ScreenItems("控件1")
Set DTPicker2 = ScreenItems("控件2")
item.Enabled = False
sheetname = "Sheet1"
'判断是否打开模版,如果打开先关闭保存
On Error Resume Next
Dim ExcelApp,ExcelBook
Set ExcelApp = GetObject(,"Excel.Application")
If TypeName(ExcleApp) = "Application" Then
For Each ExcelBook In ExcelApp.WorkBooks
If ExcelBook.FullName = "E:\WinCCWriteExecl\WinCCWriteExecl.xlsx" Then
ExcelApp.ActiveWorkbook.Save
ExcelApp.Workbooks.Close
ExcelApp.Quit
Set ExcelApp= Nothing
Exit For
End If
Next
End If
'打开Excel模板
Set objExcelApp = CreateObject("Excel.Application")
objExcelApp.Visible = True
objExcelApp.Workbooks.Open "E:\WinCCWriteExecl\WinCCWriteExecl.xlsx"
objExcelApp.Worksheets(sheetname).Activate
'准备查询条件 Catalog
Set tagDSNName = HMIRuntime.Tags("@DatasourceNameRT")
tagDSNName.Read
'创建数据库联接
sPro = "Provider=WinCCOLEDBProvider.1;"
sDsn = "Catalog=" &tagDSNName.Value& ";"
sSer = "Data Source=T430\WinCC"
sCon = sPro + sDsn + sSer
Set conn = CreateObject("ADODB.Connection")
conn.ConnectionString = sCon
conn.CursorLocation = 3
conn.Open
'定义查询的命令文本 SQL
sSql = "ALARMVIEW:Select * FROM AlgViewCHT where DateTime>'" +Trim(DTPicker1.value)+ "' AND DateTime<'" +Trim(DTPicker2.value)+ "' AND TimeDiff <> 0 ORDER BY DateTime"
HMIRuntime.Trace "Sql is: " & sSql
Set oRs = CreateObject("ADODB.Recordset")
Set oCom = CreateObject("ADODB.Command")
oCom.CommandType = 1
Set oCom.ActiveConnection = conn
oCom.CommandText = sSql
'填充数据到Excel中
Set oRs = oCom.Execute
m = oRs.RecordCount
If (m > 0) Then
oRs.MoveFirst
i=4
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(2).Value)
objExcelApp.Worksheets(sheetname).cells(i,3).value= CStr(oRs.Fields(37).Value)
objExcelApp.Worksheets(sheetname).cells(i,4).value= CStr(oRs.Fields(38).Value)
objExcelApp.Worksheets(sheetname).cells(i,5).value= CStr(oRs.Fields(32).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
'释放资源
Set oRs = Nothing
conn.Close
Set conn = Nothing
'生成新的文件,关闭Excel
Dim patch,filename
'filename=CStr(Year(Now))&"-"&CStr(Month(Now))&"-"&CStr(Day(Now))&" "&CStr(Hour(Now))&"点"&CStr(Minute(Now))&"分"&CStr(Second(Now))&"秒"
filename=CStr(Year(DTPicker1.value))&"-"&CStr(Month(DTPicker1.value))&"-"&CStr(Day(DTPicker1.value))&" "&CStr(Hour(DTPicker1.value))&"点"&CStr(Minute(DTPicker1.value))&"分"&CStr(Second(DTPicker1.value))&"秒至"&CStr(Year(DTPicker2.value))&"-"&CStr(Month(DTPicker2.value))&"-"&CStr(Day(DTPicker2.value))&" "&CStr(Hour(DTPicker2.value))&"点"&CStr(Minute(DTPicker2.value))&"分"&CStr(Second(DTPicker2.value))&"秒的报警归档日志"
patch= "E:\WinCCWriteExecl\"&filename&".xlsx"
objExcelApp.ActiveWorkbook.SaveAs patch
objExcelApp.Workbooks.Close
objExcelApp.Quit
Set objExcelApp= Nothing
MsgBox "成功生成数据文件!"
item.Enabled = True
麻烦高人帮忙看下,谢谢了
我把程序放进按钮的VB脚本中,也加了MsgBox来做断点,感觉主要是Select * FROM AlgViewCHT where DateTime>'" +Trim(DTPicker1.value)+ "' AND DateTime<'" +Trim(DTPicker2.value)+ "' AND TimeDiff <> 0 ORDER BY DateTime的问题,我把时间的条件删掉,就能把所有的报警归档全部导出,加上这句话之后就无法导出了