IFIX連接SQL讀寫資料和製作excel報表

Option Explicit

'引用microsoft activeX Data objects 2.X library

'引用microsoft activeX Data objects recordset 2.X

'引用Microsoft excel 15.0 object library

Dim a As String '定義中間變數，用來暫存從資料庫中取出的資料

Dim b As String

Dim c As String

Dim d As String

Dim enddayplus1 As Integer

Dim rsADO As ADODB.Recordset '定義連接資料庫的ADO變數

Dim conn As New ADODB.Connection

Public CmdTruck As New ADODB.Command

Public dbUpdata As New ADODB.Command

Public rstUpdata As New Recordset

Private Sub CommandButton3_Click() '點擊按鈕的回應函數

    Fix32.AB_FIX.SDAY.A_CV = Fix32.AB_FIX.Year.A_CV + "-" + Fix32.AB_FIX.Month.A_CV + "-" + Fix32.AB_FIX.Day.A_CV

    enddayplus1 = Val(Fix32.AB_FIX.EDay.A_CV) + 2

    Fix32.AB_FIX.ENDAY.A_CV = Fix32.AB_FIX.EYear.A_CV + "-" + Fix32.AB_FIX.EMonth.A_CV + "-" + Str(enddayplus1)

    Call showbb '調用顯示報表的函數showbb

    Call closeDB1 '調用關閉資料庫的函數

    closeDB1

End Sub

Private Sub showbb()

    Dim COL1 As String

    Dim COL2 As String

    Dim COL3 As String

    Dim COL4 As String

    COL1 = "ALM_NATIVETIMEIN"

    COL2 = "ALM_TAGNAME"

    COL3 = "ALM_VALUE"

    COL4 = "ALM_DESCR"

    Dim Rs As New ADODB.Recordset '定義連接資料庫的ADO變數

    openDB1 '打開DB1資料庫，該函數在後面有定義

    CmdTruck.ActiveConnection = conn

    CmdTruck.CommandText = "SELECT ALM_NATIVETIMEIN, ALM_TAGNAME, ALM_VALUE, ALM_DESCR FROM FIXALARMS WHERE ALM_NATIVETIMEIN Between " + "'" + Fix32.AB_FIX.SDAY.A_CV + "'" + " AND " + "'" + Fix32.AB_FIX.ENDAY.A_CV + "'" + " And ALM_TAGNAME! = '' "    '按需求生成ADODB.recordset

    Dim xlApp As Object '定義報表物件

    Dim xlBook As Object

    Dim xlSheet As Object

    Dim e As String

    Dim f As String

    Dim g As String

    Dim h As String

    Dim i As Integer

    i = 2  'ADODB.recordset要寫入EXCEL的ROW數,從ROW2開始寫,ROW1留給中文說明標題了

    e = "報警時間"

    f = "報警點"

    g = "狀態"

    h = "說明"

    'On Error GoTo errorhandle

    Set xlApp = New Excel.Application

    Set xlBook = xlApp.Workbooks.Open(System.ProjectPath & "\app\temp.xls")     '打開報表範本此範本可以調整樣式,不要放值就好,輸出的報表就會按設計的樣式輸出

    Set xlSheet = xlBook.Worksheets(1)

    xlApp.DisplayAlerts = False  '警告禁用

    xlApp.Visible = False 'EXCEL隱藏

    xlSheet.Cells(1, 1) = e & ""    '第一行的標題文字說明

    xlSheet.Cells(1, 2) = f & ""

    xlSheet.Cells(1, 3) = g & ""

    xlSheet.Cells(1, 4) = h & ""

    Set Rs = CmdTruck.Execute   '執行SQL語句生成ADODB.RecordSet

    While (Not Rs.EOF)           '只要不是指向ADODB.RecordSet最後一筆資料將讀出來的數據傳給變數a、b、c、d

        a = Rs(COL1)

        b = Rs(COL2)

        c = Rs(COL3)

        d = Rs(COL4)

        xlSheet.Cells(i, 1) = a & ""      '將變數的值寫到對應excel的儲存格

        xlSheet.Cells(i, 2) = b & ""

        xlSheet.Cells(i, 3) = c & ""

        xlSheet.Cells(i, 4) = d & ""

        Rs.MoveNext '指向下一條ROW

        i = i + 1

    Wend

    xlSheet.SaveAs System.ProjectPath & "\app\report.htm", FileFormat:=xlHtml '工作表另存為html

    xlSheet.SaveAs System.ProjectPath & "\app\report.xls" '工作表另存為xls

    xlApp.DisplayAlerts = True '警告使能

    xlApp.Quit

    Me.WebBrowser1.Navigate System.ProjectPath & "\app\report.htm" '在WebBrowser控制項上顯示報表

    xlApp.Quit

    Set xlSheet = Nothing '釋放記憶體

    Set xlBook = Nothing

    Set xlApp = Nothing

    Set CmdTruck = Nothing

    Set Rs = Nothing

Exit Sub

errorhandle:

    MsgBox "報表生成錯誤！", vbOKOnly + vbInformation, "信息..."

    Set xlSheet = Nothing   '釋放記憶體

    Set xlBook = Nothing

    Set xlApp = Nothing

End Sub

Public Sub openDB1()       '定義打開資料庫的函數openDB1

    If conn.State <> adStateOpen Then

        With conn

        .ConnectionString = "Driver={SQL Server};Server=127.0.0.1;Database=msdb;Uid=sa;Pwd=123456789;"   '連接資料來源的相關資訊

        .ConnectionTimeout = 30

        .Mode = adModeReadWrite

        .Open

        End With

    End If

End Sub

Public Sub closeDB1() '定義關閉資料庫的函數closeDB1

    If conn.State = adStateOpen Then

        conn.Close

    End If

End Sub