有段Txt文本导入access的代码，调试不通，希望高手帮忙！

Question

Option Explicit
Dim Cat As New ADOX.Catalog
Dim Col As Column
Dim Tbl As Table
Dim lFieldLength() As Long
Dim strFieldName() As String
Dim strFieldValue() As String
Dim FieldCount As LongPublic Function CreateDatabase()On Error GoTo PROC_ERR    Cat.Create "Microsoft.Jet.OLEDB.4.0;Data Source=" & TxtDes.Text    CreateDatabase = True    Exit FunctionPROC_ERR:    CreateDatabase = False
    
    If Err.Number = -2147217897 Then
    
        MsgBox "数据库已经存在"
        
        Exit Function
        
    Else
    
        MsgBox Err.Number & vbNewLine & Err.Description
        
    End IfEnd FunctionPrivate Function CreateTables()    Dim i As Long
    
    Set Tbl = New ADOX.Table
    
    With Tbl
        
        .Name = txtTabel.Text
        
        Set .ParentCatalog = Cat
        
        With .Columns
            
            For i = 0 To FieldCount - 1
                
                .Append strFieldName(i), adVarChar, lFieldLength(i)
                
                .Item(strFieldName(i)).Properties("Description").Value = strFieldName(i)
                
            Next i
            
        End With
        
    End With
    
    Cat.Tables.Append Tbl
    
    Set Tbl = NothingEnd FunctionPrivate Sub GetFieldinfo()    Dim Readline As String    Dim lSeek As Long    Open TxtSource.Text For Input As #1    If EOF(1) Then Exit Sub    Line Input #1, Readline        Do While lSeek > 0            FieldCount = FieldCount + 1
    
            lSeek = InStr(lSeek + 1, Readline, TxtChar.Text, vbTextCompare)        Loop
    
    FieldCount = FieldCount + 1
    
    ReDim strFieldName(FieldCount)
    
    ReDim lFieldLength(FieldCount)
    
    ReDim strFieldValue(FieldCount)
    
    strFieldName() = Split(Readline, TxtChar.Text)
    
    Close #1
    
    Call GetFieldLength
    
End SubPrivate Sub GetFieldLength()    Dim Readline As String
    
    Dim i As Long
    
    Open TxtSource.Text For Input As #1
    
    Line Input #1, Readline
    
    Do Until EOF(1)
        
        Line Input #1, Readline
        
        strFieldValue() = Split(Readline, TxtChar.Text)
        
        For i = 0 To FieldCount - 1
            
            If lFieldLength(i) < Len(strFieldValue) Then
            
                lFieldLength(i) = Len(strFieldValue)
                
            End If
        
        Next i
    
    Loop
            
    Close #1End Sub
Private Sub Export2Database()    Dim DataConn As New ADODB.Connection
    
    Dim DataRec As New ADODB.Recordset
    
    Dim Readline As String
    
    Dim i As Long
    
    Dim strSQL As String
    
    Set Cat = Nothing
    
    On Error GoTo ConnectionERR
    
        DataConn.ConnectionString = "Microsoft.Jet.OLEDB.4.0;Data Source=" & TxtDes.Text
    
        DataConn.Open
        
    On Error GoTo RecordSetERR
    
        strSQL = "select * from " & TxtTable.Text
        
    On Error GoTo ExportERR
        
        Open TxtSource.txt For Input As #1
        
        If EOF(1) Then Exit Sub
        
        Line Input #1, Readline
        
        Do Until EOF(1)
            
            Line Input #1, Readline
                      
            strFieldValue() = Split(Readline, TxtChar.Text)
            
            DataRec.AddNew
            
            For i = 0 To FieldCount - 1
            
                DataRec.Fields(i).Value = strFieldValue
                
            Next i
            
            DataRec.Update
            
        Loop
        
        DataRec.UpdateBatch
        
        Close #1
        
        DataRec.Close
        
        Set DataRec = Nothing
        
        Exit Sub
        
ConnectionERR:        MsgBox "数据库连接错误，" & Err.Description, vbCritical, "出错"
    
        Exit Sub
        
RecordSetERR:
        
        MsgBox "RecordSet生成错误，" & Err.Description, vbCritical, "出错"
        
        DataConn.Close
        
        Exit Sub
        
DocERR:
        
        MsgBox "导入Access数据库错误，" & Err.Description, vbCritical, "出错"
        
        DataRec.Close
        
        DataConn.Close
    
End Sub
Private Sub cmdOK_Click()    Call GetFieldinfo
    
    If CreateDatabase Then
    
        Call CreateTables
        
        Call Export2Database
        
    End If
    
    MsgBox "导出成功。", vbInformation, "出错"
    
End Sub