关于VBS脚本查询按时间查询并生成EXCEL,求高手讲解!

已锁定

凯淋

  • 帖子

    20
  • 精华

    0
  • 被关注

    0

论坛等级:游民

注册时间:2014-03-28

普通 普通 如何晋级?

关于VBS脚本查询按时间查询并生成EXCEL,求高手讲解!

2196

18

2015-03-10 11:19:35

这是一段查询按钮的代码,小弟看的不是很明白,希望能有专家帮忙解释一下每段语句的大概意思!不胜感激!
Sub OnLButtonUp(ByVal Item, ByVal Flags, ByVal x, ByVal y)
Dim sPro,sDsn,sSer,sCon,conn,sSql,oRs,oCom
Dim tagDSNName
Dim m,i
Dim LocalBeginTime, LocalEndTime,UTCBeginTime, UTCEndTime,sVal
Dim objExcelApp,objExcelBook,objExcelSheet,sheetname
item.Enabled = False
On Error Resume Next
sheetname="Sheet1"
Set objExcelApp = CreateObject("Excel.Application")
objExcelApp.Visible = False
objExcelApp.Workbooks.Open "D:\WinCCWriteExcel\abc.xlsx"
objExcelApp.Worksheets(sheetname).Activate
Set tagDSNName = HMIRuntime.Tags("@DatasourceNameRT")
tagDSNName.Read
Set LocalBeginTime = HMIRuntime.Tags("strBeginTime")
LocalBeginTime.Read
Set LocalEndTime = HMIRuntime.Tags("strEndTime")
LocalEndTime.Read
UTCBeginTime = DateAdd("h" ,-8,LocalBeginTime.Value)
UTCEndTime= DateAdd("h" ,-8,LocalEndTime.Value)
UTCBeginTime = Year(UTCBeginTime) & "-" & Month(UTCBeginTime) & "-" & Day(UTCBeginTime) & " " & Hour(UTCBeginTime) & ":" & Minute(UTCBeginTime) & ":" & Second(UTCBeginTime)
UTCEndTime = Year(UTCEndTime) & "-" & Month(UTCEndTime) & "-" & Day(UTCEndTime) & " " & Hour(UTCEndTime) & ":" & Minute(UTCEndTime) & ":" & Second(UTCEndTime)
HMIRuntime.Trace "UTC Begin Time: " & UTCBeginTime & vbCrLf
HMIRuntime.Trace "UTC end Time: " & UTCEndTime & vbCrLf
Set sVal = HMIRuntime.Tags("sVal")
sVal.Read
sPro = "Provider=WinCCOLEDBProvider.1;"
sDsn = "Catalog=" &tagDSNName.Value& ";"
sSer = "Data Source=.\WinCC"
sCon = sPro + sDsn + sSer
Set conn = CreateObject("ADODB.Connection")
conn.ConnectionString = sCon
conn.CursorLocation = 3
conn.Open
sSql = "Tag:R,('PVArchive\NewTag'),'" & UTCBeginTime & "','" & UTCEndTime & "',"
sSql=sSql+"'order by Timestamp ASC','TimeStep=" & sVal.Value & ",1'"
MsgBox sSql
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
If (m > 0) Then
objExcelApp.Worksheets(sheetname).cells(2,1).value=oRs.Fields(0).Name
objExcelApp.Worksheets(sheetname).cells(2,2).value=oRs.Fields(1).Name
objExcelApp.Worksheets(sheetname).cells(2,3).value=oRs.Fields(2).Name
objExcelApp.Worksheets(sheetname).cells(2,4).value=oRs.Fields(3).Name
objExcelApp.Worksheets(sheetname).cells(2,5).value=oRs.Fields(4).Name
oRs.MoveFirst
i=3
Do While Not oRs.EOF
objExcelApp.Worksheets(sheetname).cells(i,1).value= oRs.Fields(0).Value
objExcelApp.Worksheets(sheetname).cells(i,2).value= GetLocalDate(oRs.Fields(1).Value)
objExcelApp.Worksheets(sheetname).cells(i,3).value= oRs.Fields(2).Value
objExcelApp.Worksheets(sheetname).cells(i,4).value= oRs.Fields(3).Value
objExcelApp.Worksheets(sheetname).cells(i,5).value= 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
Set oRs = Nothing
conn.Close
Set conn = Nothing
Dim patch,filename
filename=CStr(Year(Now))&""&CStr(Month(Now))&""&CStr(Day(Now))&""&CStr(Hour(Now))&""&CStr(Minute(Now))&""&CStr(Second(Now))
patch= "d:\"&filename&"demo.xlsx"
objExcelApp.ActiveWorkbook.SaveAs patch
objExcelApp.Workbooks.Close
objExcelApp.Quit
Set objExcelApp= Nothing
MsgBox "成功生成数据文件!"
item.Enabled = True
End Sub
关于VBS脚本查询按时间查询并生成EXCEL,求高手讲解! 已锁定
编辑推荐: 关闭

请填写推广理由:

本版热门话题

SIMATIC WinCC / Panel

共有32891条技术帖

相关推荐

热门标签

相关帖子推荐

guzhang

恭喜,你发布的帖子

评为精华帖!

快扫描右侧二维码晒一晒吧!

再发帖或跟帖交流2条,就能晋升VIP啦!开启更多专属权限!

  • 分享

  • 只看
    楼主

top
X 图片
您收到0封站内信:
×
×
信息提示
很抱歉!您所访问的页面不存在,或网址发生了变化,请稍后再试。