Private Sub Command6_Click()
Set cat = New ADOX.Catalog
Set conn = New ADODB.Connection
Set rs = New ADODB.Recordset
Set rs1 = New ADODB.Recordset
Dim i, Y As Byte
CD1.CancelError = True
On Error GoTo ErrHandler    Dim fm As String 'fm变量用来获取用户输入的文件名
    
    CD1.Filter = "MDB文件(*.mdb)|*.mdb|AllFiles(*.*)|*.*|"
    CD1.FilterIndex = 1
    CD1.InitDir = "E:Jthpaper"
    CD1.Flags = &H2
    CD1.Action = 2
    
    fm = CD1.FileName
If fm = "" Then
   MsgBox "你必须输入一个文件名,请重新保存一次!"
   Exit Sub
Else
    
    pstr = "Provider=Microsoft.Jet.OLEDB.4.0;"  '不能把这里的4.0改为3.51
    pstr = pstr & "Data Source=" & fm
    
    cat.Create pstr    '创建数据库
    
    Dim tbl As New Table
    cat.ActiveConnection = pstr
    tbl.Name = "MyTable" '表的名称
     MSG1.Row = 0
    For i = 0 To MSG1.Cols - 1
    
    MSG1.Col = i
    tbl.Columns.Append MSG1.Text, adVarWChar, 10 '表的第一个字段adInteger    Next
    cat.Tables.Append tbl '建立数据表
    conn.Open pstr
    rs.CursorLocation = adUseClient
    rs.Open "MyTable", conn, adOpenKeyset, adLockPessimistic
    For i = 1 To 1
     MSG1.Row = i
     rs.AddNew '往表中添加新记录
    'Call deley
     For Y = 0 To MSG1.Cols - 1
    
     MSG1.Col = Y
     rs.Fields(0 + Y).Value = MSG1.Text
    
     Next Y
    'Call deley
     rs.Update
     
    Next
    
    
    Dim tbl1 As New Table
    cat.ActiveConnection = pstr
    tbl1.Name = "Mycs1" '表的名称
    MSG4.Row = 0
    For i = 0 To MSG4.Cols - 1
    
    MSG4.Col = i
    tbl1.Columns.Append MSG4.Text, adVarWChar, 10 '表的第一个字段adInteger
    
    Next
    cat.Tables.Append tbl1 '建立数据表
    'conn.Open pstr
    rs1.CursorLocation = adUseClient
  
    rs1.Open "Mycs1", conn, adOpenKeyset, adLockPessimistic
    
    MSG4.Row = 1
    rs1.AddNew '往表中添加新记录
    
    For i = 0 To MSG4.Cols - 1
    
    MSG4.Col = i
    rs1.Fields(0 + i).Value = MSG4.Text
    
    Next
    
    rs1.Update
    
 End If
 Exit Sub
 
ErrHandler: MsgBox "你按下了取消键!"
Exit Sub
End Sub