excel - 是什么导致 VBA 用户窗体中的 -2147352571 类型不匹配错误？

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

标签： excelms-accessvba

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      |
+---------------+--------------+

我有一行要在 Excel 的 Sheet1 上插入。我的标题位于第 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