两个数据库相同表数据比对Excel宏例子

 

'-----thisWorkBoot

 

Option Explicit

 

'========create bywyp at 2011-10-17 ====

'*******Excel打开自动运行宏****

Private SubWorkbook_Open()

    '初始化全局变量,如数据库连接句柄等,并尝试打开数据库

    init_db

    'MsgBox ("excel打开")

End Sub

 

'*******Excel关闭自动运行宏****

Private SubWorkbook_BeforeClose(Cancel As Boolean)

    '关闭excel,并关闭数据库连接,undef全局变量

    close_db

    'MsgBox ("谢谢使用")

 

End Sub

 

'--------------过程

Option Explicit

 

'******定义全局变量******

Public objConnNpmdbAs Object    '保存生产库npmdb数据库的连接句柄

Public objConnVpmdbAs Object    '保存修饰库vpmdb数据库的连接句柄

Public objRst AsObject       '连接最近一次数据库操作的记录集

Public strSQL AsString       '最近一次执行的SQL语句

Public strConnNpmdbAs String

'="Provider=Ifxoledbc;Password=****;Persist Security Info=True;UserID=****;Data Source=npmdb@wnmsserver1;Extended Properties=''"

Public strConnVpmdbAs String

'="Provider=Ifxoledbc;Password=****;Persist Security Info=True;UserID=****;Data Source=vpmdb@nmosserver1;Extended Properties=''"

 

Sub init_db()

strConnNpmdb ="Provider=Ifxoledbc;Password=****;Persist Security Info=True;UserID=npmuser;Data Source=npmdb@wnmsserver1;Extended Properties=''"

strConnVpmdb ="Provider=Ifxoledbc;Password=****;Persist Security Info=True;UserID=npmuser;Data Source=vpmdb@nmosserver1;Extended Properties=''"

 

    Set objConnNpmdb =connect_database(strConnNpmdb)

    Set objConnVpmdb =connect_database(strConnVpmdb)

    MsgBox "连接npmdb,vpmdb成功"

End Sub

 

Sub close_db()

    objConnNpmdb.Close

    Set objConnNpmdb = Nothing

    objConnVpmdb.Close

    Set objConnVpmdb = Nothing

    MsgBox "关闭npmdb,vpmdb数据库连接"

End Sub

 

 

 

Subget_kpis(strTabName As String, dDateTime As Date, strTime As String, strWhereAs String, strUniqueKey As String)

'取某个表的某个小时数据

'入口参数: 表名称,检查时间,时间字段名称,唯一键串

    'Dim NewSheet As Worksheet

    If isExistSheet(strTabName) Then   '如果sheet存在,则先删除掉原来sheet

        Worksheets(strTabName).Activate

        Application.DisplayAlerts = False

        ActiveSheet.Delete

        Application.DisplayAlerts = True

    End If

        Worksheets.Addafter:=Worksheets(getLastSheetName()) '新增一个sheet

        ActiveSheet.Name = strTabName

   

   

    Dim objRst As Object

    Dim strKpis As String

    Dim line_num As Integer

    Dim col_num As Integer

    Dim i As Integer

    Dim fieldNo As Integer

    Dim recordNo As Integer

    Dim strNeName As String

    Dim sNextCol As String

   

   

    If strWhere <> "" Then

        strWhere = " and " &strWhere

    End If

  

  

    strKpis = get_kpi_names(strTabName)

    If InStr(strTabName, "tpa_") Then

    '   MsgBox ("没有定义需要检查的KPI,仅返回记录条数")

        strNeName ="npmdb@wnmsserver1:soa_get_nename(ne_id,ne_type) ne_name"

    Else

        strNeName = "to_name(ne_id)ne_name"

    End If

    strSQL = "select " + strNeName +"," + strTime + strKpis + " from " + strTabName + "where " + strTime + " = '"

    strSQL = strSQL & dDateTime &"' " & strWhere & " order by " + strUniqueKey +";"

'    MsgBox strSQL

   

    'rs.Fields.Count：RecordSet对象字段数。

 

    Set objRst =exec_sql_with_rst(objConnVpmdb, strSQL)

    fieldNo = objRst.Fields.Count

   

     If objRst.bof And objRst.EOF Then '没有查到记录

        recordNo = 0

     Else

            'movelast，再取AbsolutePosition

        objRst.MoveLast

        recordNo = objRst.AbsolutePosition

        objRst.MoveFirst

     End If

   

   

   

    'recordNo = objRst.Record.Count

    'MsgBox (recordNo)

    ActiveSheet.Cells(1, 1) = "检查表名"

    ActiveSheet.Cells(1, 2) = strTabName

   

    ActiveSheet.Cells(2, 1) = "检查时间"

    ActiveSheet.Cells(2, 2) = dDateTime

    ActiveSheet.Cells(1, 3) ="检查KPI个数"

    ActiveSheet.Cells(1, 4) = fieldNo - 2

   

    ActiveSheet.Cells(2, 3) ="vpmdb记录条数"

    ActiveSheet.Cells(2, 4) = recordNo

   

   

    '设置表头格式

    设置表格边框 (ActiveSheet.Range(Cells(1, 1),Cells(2, 6)))

    设置字体_非日期 (ActiveSheet.Range(Cells(1, 1),Cells(2, 6)))

    设置表格边框 (ActiveSheet.Range(Cells(1, 1),Cells(2, 6)))

    ActiveSheet.Range("A1:A2").Select