比较两个SQLSERVER的数据结构的不同

 Option Explicit
'------------------------------------------------------------
'比较两个SQLSERVER的数据结构的不同  作者:陈炎和
'------------------------------------------------------------
Private Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long

Private Cnn1 As ADODB.Connection, Cnn2 As ADODB.Connection

Private Sub main()
Dim ServerName As String, DataBase As String, UserName As String, password As String
Dim iniName As String
iniName = App.Path & IIf(Len(App.Path) > 3, "/", "") & App.EXEName & ".ini"
Set Cnn1 = New ADODB.Connection
   ServerName = GetProfileString("DataBase1", "serverName", "", iniName)(0)
   DataBase = GetProfileString("DataBase1", "database", "", iniName)(0)
   password = GetProfileString("DataBase1", "password", "", iniName)(0)
   UserName = GetProfileString("DataBase1", "username", "", iniName)(0)
Call conn(Cnn1, ServerName, DataBase, UserName, password)
Call createProc(Cnn1)
Set Cnn2 = New ADODB.Connection

   ServerName = GetProfileString("DataBase2", "serverName", "", iniName)(0)
   DataBase = GetProfileString("DataBase2", "database", "", iniName)(0)
   password = GetProfileString("DataBase2", "password", "", iniName)(0)
   UserName = GetProfileString("DataBase2", "username", "", iniName)(0)
Call conn(Cnn2, ServerName, DataBase, UserName, password)
Call createProc(Cnn2)
Call writeLog
End Sub
'--------------------------------------------
'写入文件
'--------------------------------------------
Private Sub writeLog()
 Dim fn As Integer
 On Error GoTo errSave
 fn = FreeFile(0)
 Open App.Path & IIf(Len(App.Path) > 3, "/", "") & App.EXEName & ".log" For Output As #fn
 Print #fn, checkTable()
 Print #fn, CheckProc()
 Close #fn
 MsgBox "比较完成,结果写入" & App.EXEName & ".log"
 Exit Sub
errSave:
   If Err > 0 Then MsgBox "错误：" & Err & " " & Error$
   On Error Resume Next
   If fn > 0 Then Close #fn
End Sub

'--------------------------------------------
'比校两个数据库中的所有表及字段
'--------------------------------------------
Private Function checkTable() As String
Dim rec1 As ADODB.Recordset, rec2 As ADODB.Recordset
Dim tablename As String, fieldname As String, i As Integer, flag As Boolean
Dim Msg As String
Set rec1 = getTableMsg(Cnn1)
Set rec2 = getTableMsg(Cnn2)
Do While rec1.EOF = False
  If tablename <> rec1.Fields("表名") Or flag = False Then
    flag = False
    tablename = rec1.Fields("表名")
    fieldname = rec1.Fields("字段名")
    rec2.Filter = "表名='" & tablename & "'"
    If rec2.RecordCount = 0 Then
      Msg = Msg & vbCrLf & "目标2欠:" & tablename
      flag = True
    Else
      rec2.Filter = "表名='" & tablename & "' and 字段名='" & fieldname & "'"
      If rec2.RecordCount = 0 Then
         Msg = Msg & vbCrLf & "目标2欠:" & tablename & "->" & fieldname
      Else
         For i = 0 To rec1.Fields.Count - 1
              If rec1(i) <> rec2(i) Then Msg = Msg & vbCrLf & "不同:" & tablename & "->" & fieldname & ">>" & rec1(i).Name
         Next<