如何用VB编程读出IFIX2.6中tag的实时数据

告诉你一个容易的方法，用DDE读IFIX标签中的实时数据。 条件： IFIX的节点名为FIX 标签名为ai 程序： 运行IFIX 运行DMDDE.EXE 在VB中建立一个TEXT控件,并填写以下代码

Private Sub Form_Load()

Text1.LinkTopic = "dmdde|data"

Text1.LinkItem = "fix.ai.f_cv"

Text1.LinkMode = 1

End Sub

运行这个程序。

Private Sub 历史报表Btn_Click()

'注释: 1。该程序需要安装ADO 2.0目标库并在本机注册

' 2。Microsoft ActiveX Data Objects 2.1 Library 必须被引用 (Office 2000)

' 3。Microsoft Excel 9.0 object libraries 必须被引用 (Office 2000)

' 4。划===处可根据具体报表修改

Dim strQuery As String

Dim c, i As Integer

Dim r As Integer

Dim Rpt_xls As Excel.Application

Dim dnm(4) As String

Dim MyDate, MyMonth, MyDay, MyHour, MyMinute, MySecond

Dim stDate, stMonth, stDay, stHour, stinute, stSecond, sttime As String

Dim StartTime, EndTime, Duration, DisplayDay, DisplayMonth As String

'++===================================================================

'报表中的 TAG

Dim Items As Integer

dnm(1) = "AI1"

dnm(2) = "AI2"

dnm(3) = "AI3"

dnm(4) = "AI4"

'从历史库中取得域项， 2 - DATATIME, VALUE, TAG 共三项

'--====================================================================

stDate = Date$

sttime = Time$

StartTime = stDate &" 00:00:00"

EndTime = stDate + " " + sttime

Set Rpt_xls = New Excel.Application

Rpt_xls.Visible = True

'++============================================================================

'打开的报表文件名

Dim OutReportFile As String

Dim Rpt_f2 As String

Rpt_f2 = "d:\Dynamics\App\HIST"

Rpt_xls.Workbooks.Open Rpt_f2 &".XLS"

Rpt_xls.Sheets("Sheet1").Select

Range("e1").Select

Selection.NumberFormatLocal = "yyyy-mm-dd hh:mm:ss"

Cells(1, 4).Value = stDate &"-" &sttime

'Rpt_xls.ActiveWorkbook.SaveAs (Rpt_f2 &stDate)

'++==========================================================================

Dim cnADO As New ADODB.Connection

Dim rsADO As Recordset

Set cnADO = New ADODB.Connection

cnADO.ConnectionString = "DSN = FIX Dynamics Historical DataUID =PWD = "

cnADO.Open "FIX Dynamics Historical Data", "", ""

'============================================================================

'查询，根据报表修改。注意，在“Select VALUE FROM mynd“中，mynd是当前SCADA节点名。

For i = 1 To 4

r = 3

strQuery = "Select VALUE FROM mynd " &_

"WHERE (TAG='" &dnm(i) &"'and " &_

"INTERVAL = '00:30:00' and " &_

"DATETIME >= {ts '" &StartTime &"'} and " &_

"DATETIME <= {ts '" &EndTime &"'})"

'--===========================================================================

MsgBox (strQuery)

Set rsADO = New ADODB.Recordset

rsADO.Open strQuery, cnADO, adOpenForwardOnly, adLockBatchOptimistic

rsADO.MoveFirst

Rpt_xls.Columns("a").Select

Selection.NumberFormatLocal = "yyyy-mm-dd hh:mm:ss"

While rsADO.EOF <>True

' MsgBox ("有记录")

Cells(r, i + 1).Value = rsADO.Fields(0)

Cells(r, i + 1).NumberFormatLocal = "0.00"

r = r + 1

rsADO.MoveNext

Wend

MsgBox (r)

Next i

Set cnADO = Nothing

'Rpt_xls.ActiveSheet.PageSetup.Orientation = xlPortrait 'xlLandscape

'Rpt_xls.ActiveSheet.PageSetup.PaperSize = xlPaperA4

'Rpt_xls.ActiveSheet.PrintOut

'Rpt_xls.DisplayAlerts = False

Rpt_xls.ActiveWorkbook.Save

'OutReportFile = Rpt_f2 &"_00" &MyMonth &MyDay

'Rpt_xls.ActiveWorkbook.SaveAs OutReportFile

Rpt_xls.ActiveWorkbook.SaveAs (Rpt_f2 &stDate)

Rpt_xls.Quit

Rpt_xls.DisplayAlerts = True

Set Rpt_xls = Nothing

End Sub

Private Sub 历史数据库Btn_Click()

'注释: 1。该程序需要安装ADO 2.0目标库并在本机注册

' 2。Microsoft ActiveX Data Objects 2.1 Library 必须被引用 (Office 2000)

' 3。Microsoft Excel 9.0 object libraries 必须被引用 (Office 2000)

' 4。划===处可根据具体报表修改

Dim strQuery As String

Dim c As Integer

Dim r As Integer

Dim Intyexcel As Excel.Application

Dim MyDate, MyMonth, MyDay, MyTime, MyHour, MyMinute, MySecond

Dim StartTime, EndTime, Duration, DisplayDay, DisplayMonth As String

'从历史库中取得域项， 2 - DATATIME, VALUE, TAG 共三项

Items = 2

'--====================================================================

MyDate = Format(Now(), "yyyy-mm-dd")

MyTime = Format(Now(), "h:m:s")

StartTime = MyDate &" " &"00:00:00"

EndTime = Now()

'++==========================================================================

' strQuery = "Select value from Fix " + _

' " Where DATETIME >={ts '" + StrStarTime + "'} AND " + _

' "DATETIME <={ts '" + StrEndTime + "'} AND " + _

' "Tag = " &" '" &HisDate5(i, 0) &"'"

'查询，根据报表修改

strQuery = "Select * From MYND " + _

"WHERE (DATETIME >= {ts '" &StartTime &"'} and " + _

"DATETIME <= {ts '" &EndTime &"'}) and " + _

"(tag = 'AI1')" + _

"and INTERVAL = '00:30:00' "

'--===========================================================================

Dim cnADO As New ADODB.Connection

Dim rsADO As Recordset

Set cnADO = New ADODB.Connection

cnADO.ConnectionString = "DSN = FIX Dynamics Historical DataUID = PWD = "

cnADO.Open "FIX Dynamics Historical Data", "", ""

Set rsADO = New ADODB.Recordset

'Rs.Open strQuery, Cn, adOpenStatic, 3, adCmdText

rsADO.Open strQuery, cnADO, adOpenForwardOnly, adLockBatchOptimistic

'rsADO.MoveFirst

'++============================================================================

'打开的报表文件名

Dim Rpt_xls As Excel.Application

Dim OutReportFile As String

Dim Rpt_f1 As String

Set Rpt_xls = New Excel.Application

Rpt_xls.Visible = True

Rpt_f1 = "d:\Dynamics\App\rt1"

Rpt_xls.Workbooks.Open Rpt_f1 &".XLS"

'Rpt_xls.ActiveWorkbook.SaveAs (Rpt_f1 &stDate)

'===============================================================================

Rpt_xls.Sheets("Sheet2").Select

Rpt_xls.Range("E1").Select

r = 3

Selection.NumberFormatLocal = "yyyy-mm-dd hh:mm:ss"

Cells(1, 5).Value = EndTime

While rsADO.EOF <>True

If rsADO(c) <>"" Then

Cells(r, 1) = rsADO.Fields(0)

Cells(r, 2) = rsADO.Fields(1)

Cells(r, 3) = rsADO.Fields(2)

Cells(r, 4) = rsADO.Fields(3)

Cells(r, 5) = rsADO.Fields(4)

Cells(r, 6) = rsADO.Fields(5)

Cells(r, 7) = rsADO.Fields(6)

Cells(r, 8) = rsADO.Fields(7)

Cells(r, 9) = rsADO.Fields(8)

End If

r = r + 1

rsADO.MoveNext

Wend

'Intyexcel.Sheets("Sheet1").Select

'Intyexcel.ActiveSheet.PageSetup.Orientation = xlPortrait 'xlLandscape

'Intyexcel.ActiveSheet.PageSetup.PaperSize = xlPaperA4

'Intyexcel.ActiveSheet.PrintOut

'Intyexcel.DisplayAlerts = False

'Intyexcel.ActiveWorkbook.Save

'OutReportFile = InReportFile &"_00" &MyMonth &MyDay

'Intyexcel.ActiveWorkbook.SaveAs OutReportFile

'Intyexcel.Quit

'Intyexcel.DisplayAlerts = True

'Set Intyexcel = Nothing

Set cnADO = Nothing

End Sub

Private Sub 实时报表Btn_Click()

'注释: 1。该程序需要安装ADO 2.0目标库并在本机注册

' 2。Microsoft ActiveX Data Objects 2.1 Library 必须被引用 (Office 2000)

' 3。Microsoft Excel 9.0 object libraries 必须被引用 (Office 2000)

' 4。划===处可根据具体报表修改

Dim c As Integer

Dim r As Integer

Dim Rpt_xls As Excel.Application

Dim MyDate, MyMonth, MyDay, MyHour, MyMinute, MySecond

Dim stDate, stMonth, stDay, stHour, stinute, stSecond, sttime As String

Dim StartTime, EndTime, Duration, DisplayDay, DisplayMonth As String

'--====================================================================

stDate = Date$

sttime = Time$

StartTime = stDate &" 09:40:00"

EndTime = stDate + " " + sttime

r = 1

Items = 8

Set Rpt_xls = New Excel.Application

Rpt_xls.Visible = True

'++============================================================================

'打开的报表文件名

Dim OutReportFile As String

Dim Rpt_f1 As String

Rpt_f1 = "d:\Dynamics\App\rt1"

Rpt_xls.Workbooks.Open Rpt_f1 &".XLS"

Rpt_xls.ActiveWorkbook.SaveAs (Rpt_f1 &stDate)

'===============================================================================

Rpt_xls.Sheets("Sheet1").Select

Rpt_xls.Range("E1").Select

Selection.NumberFormatLocal = "yyyy-mm-dd hh:mm:ss"

Cells(1, 5).Value = stDate &sttime

'================================================================================

Cells(3, 2).Value = Fix32.mynd.ai1.f_cv

Cells(3, 3).Value = Fix32.mynd.ai2.f_cv

Cells(3, 4).Value = Fix32.mynd.ai3.f_cv

Cells(3, 5).Value = Fix32.mynd.ai4.f_cv

Range("B3:E3").Select

Selection.NumberFormatLocal = "0.00_ "

'================================================================================

Rpt_xls.ActiveSheet.PageSetup.Orientation = xlPortrait 'xlLandscape

Rpt_xls.ActiveSheet.PageSetup.PaperSize = xlPaperA4

'Rpt_xls.ActiveSheet.PrintOut

Rpt_xls.DisplayAlerts = False

Rpt_xls.ActiveWorkbook.Save

OutReportFile = Rpt_f1 &"_00" &MyMonth &MyDay

Rpt_xls.ActiveWorkbook.SaveAs OutReportFile

Rpt_xls.Quit

Rpt_xls.DisplayAlerts = True

Set Rpt_xls = Nothing

End Sub

---