目前，我正在与一个用户窗体进行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
答案 0 :(得分：0)
如评论中所述，我希望至少可以使您更接近最终目标。
在我的设置上有一些背景知识，因为此代码不一定是必需的，并且可以正常工作。
我在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