frmimportschema.frm

Data monkey是一个强大的是数据传输和转换应用程序。使用DataMonkey用户可以把复杂的文本文件格式

VERSION 5.00
Begin VB.Form frmImportSchema 
   Caption         =   "Form1"
   ClientHeight    =   2115
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   4200
   LinkTopic       =   "Form1"
   ScaleHeight     =   2115
   ScaleWidth      =   4200
   StartUpPosition =   3  'Windows Default
   Begin VB.TextBox txtSchemaName 
      Height          =   285
      Left            =   1680
      TabIndex        =   2
      Top             =   120
      Width           =   2415
   End
   Begin VB.CommandButton btnClose 
      Caption         =   "&Ok"
      Height          =   375
      Left            =   3240
      TabIndex        =   0
      Top             =   600
      Width           =   855
   End
   Begin VB.Label Label2 
      AutoSize        =   -1  'True
      Caption         =   "New Schema Name"
      Height          =   195
      Left            =   120
      TabIndex        =   1
      Top             =   120
      Width           =   1425
   End
End
Attribute VB_Name = "frmImportSchema"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub btnImport_Click()
    ImportSchema
End Sub
Function ImportSchema()

    Dim Connection As ADODB.Connection
    Dim rs As ADODB.Recordset
    Dim sch As COutputSchema
    Dim tbl As COutputTargetTable
    Dim fld As COutputTargetField
    
    Set sch = New COutputSchema
    
    Set Connection = New ADODB.Connection
    Connection.Open txtDBName.Text
    Set rs = Connection.OpenSchema(adSchemaTables)
    
    Do Until rs.EOF
        If rs("TABLE_TYPE") = "TABLE" Then
            Set tbl = sch.GetOutputTables.Add(False)
            tbl.Name = rs("TABLE_NAME")
            Set tbl = Nothing
        End If
        rs.MoveNext
    Loop
    rs.Close
    Set rs = Nothing
    
    ' Open a table with all the column (field) names.
    Set rs = Connection.OpenSchema(adSchemaColumns)
    Do Until rs.EOF
        
        ' Get a reference to the table object that will own this field.
        If Not tbl Is Nothing Then
            If Not tbl.Name = rs("TABLE_NAME") Then
                Set tbl = sch.GetOutputTables.ItemByName(rs("TABLE_NAME"))
            End If
        Else
            Set tbl = sch.GetOutputTables.ItemByName(rs("TABLE_NAME"))
        End If

        ' If we found our table object, add a field to it.
        If Not tbl Is Nothing Then
            ' Add the field object.
            Set fld = tbl.GetFields.Add(False)
            
            ' Make sure the field was added.
            If fld Is Nothing Then GoTo Done
            
            ' Setup the field properties.
            fld.Name = rs("COLUMN_NAME")
            fld.DBType = rs("DATA_TYPE")
            
            Set fld = Nothing
        End If
        rs.MoveNext
    Loop
    
Done:
    Connection.Close
    Set Connection = Nothing
    
    Dim arc As New CArchive
    Dim Filter As String
    Filter = "Schema Files(*.sch)|*.sch|All Files(*.*)|*.*"
    If arc.BrowseFileSave("Save Schema as...", , Filter) Then
        sch.SchemaType = otDB
        sch.Save arc
        arc.CloseFile
    End If
    
End Function