Системная ошибка при передаче данных из Excel в ACCESS - PullRequest
0 голосов
/ 23 февраля 2019

У меня проблема с некоторым кодом для передачи данных из EXCEL в ACCESS.Вот код:

 Sub Export_Data()
    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
    Dim nextrow As Long

    'add error handling
    'On Error GoTo errHandler:

    'Variables for file path and last row of data
    dbPath = ActiveSheet.Range("T2").Value
    nextrow = Cells(Rows.Count, 1).End(xlUp).Row

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

    'Check for data
    If Sheet3.Range("B4").Value = "" Then
    MsgBox " Add the data that you want tot send to MS Access"
    Exit Sub
    End If

    '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
    'two primary providers used in ADO SQLOLEDB —-Microsoft.JET.OLEDB.4.0 —-Microsoft.ACE.OLEDB.12.0
    'OLE stands for Object Linking and Embedding, Database

    '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:="Transactions", ActiveConnection:=cnn, _
    CursorType:=adOpenDynamic, LockType:=adLockOptimistic, _
    Options:=adCmdTable

    'you now have the recordset object
    'add the values to it
    For x = 4 To nextrow
    rst.AddNew
    For i = 2 = 1 To 21
    rst(Cells(1, i).Value) = Cells(x, i).Value
    Next i
    rst.Update
    Next x

    'close the recordset
    rst.Close
    ' Close the connection
    cnn.Close
    'clear memory
    Set rst = Nothing
    Set cnn = Nothing

    'communicate with the user
    MsgBox " The data has been successfully sent to the access database"

    'Update the sheet
    Application.ScreenUpdating = True

    'Clear the data
    Sheet3.Range("A4:G10000").ClearContents
    On Error GoTo 0
    Exit Sub

    'clear memory
    Set rst = Nothing
    Set cnn = Nothing
    MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure Export_Data"
 End Sub

Я получаю эту ошибку ....

SystemError & H80040E4D -2147217843

Что пошло не так ??Все, что я могу сказать, - это то, что мне кажется, что им трудно подобрать данные из EXCEL или поместить их в ACCESS

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...