Что вызывает ошибку несоответствия типов -2147352571 в пользовательской форме VBA?

Question

В настоящее время я работаю над соединением Access-Excel с пользовательской формой.Внутри этой пользовательской формы данные необходимо экспортировать из Excel в Access.Возникает следующая ошибка (ошибка vba - 2147352571 несоответствие типов), и я не могу найти, где проблема в моем коде, назначенном кнопке экспорта.Это мой код:

Private Sub cmdAdd_Click()

Dim cnn As ADODB.Connection 'dim the ADO collection class
Dim rst As ADODB.Recordset 'dim the ADO recordset class
Dim dbPath
Dim x As Long, i As Long
'Error handler
On Error GoTo errHandler:

dbPath = ActiveSheet.Range("I9").Value

Set cnn = New ADODB.Connection ' Initialise the collection class variable

'Connection class is equipped with a —method— named Open
'—-4 aguments—- ConnectionString, UserID, Password, Options
'ConnectionString formula—-Key1=Value1;Key2=Value2;Key_n=Value_n;
 cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & dbPath

'ADO library is equipped with a class named Recordset
 Set rst = New ADODB.Recordset 'assign memory to the recordset

'ConnectionString Open '—-5 aguments—-
'Source, ActiveConnection, CursorType, LockType, Options
 rst.Open Source:="TAGInformation", ActiveConnection:=cnn, _
 CursorType:=adOpenDynamic, LockType:=adLockOptimistic, _
 Options:=adCmdTable

 'send the data
   rst.AddNew
   For i = 1 To 213
   rst(Cells(1, i).Value) = Me.Controls("Arec" & i).Value
   Next i
   rst.Update

 'update for the next ID
 Sheet1.Range("K9").Value = Arec1.Value + 1

 'clear the userform values
 For x = 1 To 213
 Me.Controls("Arec" & x).Value = ""
 Next

 'add the next user ID
 Me.Arec1 = Sheet1.Range("K9").Value
 ' Close the connection
 rst.Close
 cnn.Close
 Set rst = Nothing
 Set cnn = Nothing

 'commuinicate with the user
 MsgBox " The data has been successfully sent to the access database"
 On Error GoTo 0
 Exit Sub
 errHandler:
 Set rst = Nothing
 Set cnn = Nothing
 MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure 
 cmdAdd"
 End Sub

Answer 1

Как указано в комментариях, есть подход, который, я надеюсь, по крайней мере приближает вас к конечной цели.

Немного предыстории моей установки, так как этот код не обязательно будет опущени это работает.

У меня есть таблица в файле Access со следующей схемой.

+---------------+--------------+
| FieldName     | FieldType    |
+---------------+--------------+
| DateField     | Date         |
+---------------+--------------+
| TextField     | ShortText    |
+---------------+--------------+
| LongIntField  | Long Integer |
+---------------+--------------+
| DoubleField   | Double       |
+---------------+--------------+
| IntField      | Integer      |
+---------------+--------------+
| CurrencyField | Currency     |
+---------------+--------------+
| LongTextField | LongText     |
+---------------+--------------+
| ByteField     | Byte         |
+---------------+--------------+
| DecimalField  | Decimal      |
+---------------+--------------+
| YesNoField    | Boolean      |
+---------------+--------------+

У меня есть строка для вставки на листе 1 Excel.Мои заголовки находятся в строке 1, а значения - в строке 2. Я использую FieldName, чтобы найти Field в коллекции Fields, чтобы иметь возможность определить тип и получить соответствующее значение, необходимое для добавления в базу данных..

Вот код:

---

Private ErrorCollection As Collection

'Probably overkill, but I found added all the ADO Field Types
Public Enum ADOFieldTypes
    adArray = 8192
    adBigInt = 20
    adBinary = 128
    adBoolean = 11
    adBSTR = 8
    adChapter = 136
    adChar = 129
    adCurrency = 6
    adDate = 7
    adDBDate = 133
    adDBTime = 134
    adDBTimeStamp = 135
    adDecimal = 14
    adDouble = 5
    adEmpty = 0
    adError = 10
    adFileTime = 64
    adGUID = 72
    adIDispatch = 9
    adInteger = 3
    adIUnknown = 13
    adLongVarBinary = 205
    adLongVarChar = 201
    adLongVarWChar = 203
    adNumeric = 131
    adPropVariant = 138
    adSingle = 4
    adSmallInt = 2
    adTinyInt = 16
    adUnsignedBigInt = 21
    adUnsignedInt = 19
    adUnsignedSmallInt = 18
    adUnsignedTinyInt = 17
    adUserDefined = 132
    adVarBinary = 204
    adVarChar = 200
    adVariant = 12
    adVarNumeric = 139
    adVarWChar = 202
    adWChar = 130
End Enum

Public Sub DBExample()
    Const ConnectionString As String = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=YOURPATHGOESHERE"
    Const SQL As String = "Select * from [Example] where id = 1" ' Simple query that returns all fields for the insert
    Set ErrorCollection = New Collection

    Dim conn            As ADODB.connection: Set conn = New ADODB.connection
    Dim rst             As ADODB.Recordset: Set rst = New ADODB.Recordset
    Dim ws              As Excel.Worksheet: Set ws = ThisWorkbook.Sheets("Sheet1")
    Dim i               As Long
    Dim Fields          As ADODB.Fields
    Dim FieldName       As String
    Dim FieldValue      As Variant
    Dim FieldType       As Long
    Dim ErrorString     As String
    Dim ErrorItem       As Variant

    conn.Open ConnectionString
    rst.Open SQL, conn, adOpenForwardOnly, adLockOptimistic
    Set Fields = rst.Fields 'Get all the fields for the Database Table

    rst.AddNew
    For i = 1 To 10
        FieldName = ws.Cells(1, i).Value2 'Get the FieldName
        FieldType = rst.Fields(ws.Cells(1, i).Value2).Type 'Get the Field's Type from ADODB
        FieldValue = ws.Cells(2, i).Value2 'Get the value to update
        rst.Fields(FieldName).Value = getFieldValue(FieldType, FieldValue, FieldName) 'Assign the value
    Next

    'If, and only if there are no errors, update the DB
    If ErrorCollection.Count = 0 Then
        rst.Update
    Else
        'Print out error descriptions, which fields are still having issues?
        For Each ErrorItem In ErrorCollection
            ErrorString = ErrorItem & vbNewLine & ErrorString
        Next

        Debug.Print ErrorString
    End If

    conn.close
End Sub

'This maps the field type, and coverts the Excel value to that type
'I've only included the types I thought were most relevant for MS Access
'My Database has the following Type in a table: Date, ShortText, Long, Double, Integer, Decimal, Byte, Boolean (Yes/No), Currency, LongText
Private Function getFieldValue(FieldType As ADOFieldTypes, FieldValue As Variant, FieldName As String) As Variant
On Error GoTo errorHandler:

    Select Case FieldType
        Case adDate
            getFieldValue = CDate(FieldValue)
        Case adVarWChar
            getFieldValue = FieldValue
        Case adInteger
            getFieldValue = CLng(FieldValue)
        Case adDouble
            getFieldValue = CDbl(FieldValue)
        Case adSmallInt
            getFieldValue = CInt(FieldValue)
        Case adCurrency
             getFieldValue = CCur(FieldValue)
        Case adLongVarWChar
            getFieldValue = FieldValue
        Case adUnsignedTinyInt
            getFieldValue = CByte(FieldValue)
        Case adNumeric
            getFieldValue = CDec(FieldValue)
        Case adBoolean
            getFieldValue = CBool(FieldValue)
    End Select

    Exit Function

errorHandler:
    'This will return the FieldType Enum value, you can reference the number returned to ADOFieldTypes
    ErrorCollection.Add "Could not add " & FieldName & " with value: " & FieldValue & " it has a type of " & FieldType
End Function