Нет импорта данных из Excel для доступа с ADO - PullRequest
0 голосов
/ 08 октября 2018

У меня есть форма в Excel, которая пишет в лист Excel.В VBA ниже я попросил ячейки обновить базу данных Access.

При загрузке данных нет ошибок, но при переходе на лист доступа нет данных нет.

Таблица доступа: (Нажмите, чтобы увеличить)
This is a snip of the access file

Sub Export_Data()
    Dim cnn As ADODB.Connection 
    Dim rst As ADODB.Recordset 
    Dim dbPath, x As Long, i As Long, nextrow As Long

    On Error GoTo errHandler: 'add error handling

    'Variables for file path and last row of data
    dbPath = Sheet19.Range("I3").Value
    nextrow = Cells(Rows.Count, 1).End(xlUp).Row
    Set cnn = New ADODB.Connection 'Initialise the collection class variable

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

    cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & dbPath
    Set rst = New ADODB.Recordset 'assign memory to the recordset 

    rst.Open Source:="SELECT * FROM [ARF Data Log]", ActiveConnection:=cnn, _
    CursorType:=adOpenDynamic, LockType:=adLockOptimistic
    Options = adCmdOpenTable

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

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

    'communicate with the user
    MsgBox " The data has been successfully sent to the access database"
    Application.ScreenUpdating = True  'Update the sheet
    Sheet19.Range("h7").Value = Sheet19.Range("h8").Value + 1 'show the next ID
    Sheet18.Range("A2:ac1000").ClearContents  'Clear the data
    On Error GoTo 0
    Exit Sub
errHandler:

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

1 Ответ

0 голосов
/ 08 октября 2018

Вам необходимо указать поля, которые вы обновляете.Это делается либо с !, либо с .Fields.Если вы не укажете, вы можете использовать индекс столбца.

- С !


Sub DataPopulation()

    Dim myConn As New ADODB.Connection
    Dim DBS As ADODB.Recordset

    Set myConn = CurrentProject.Connection
    Set DBS = New ADODB.Recordset

    DBS.Open "SomeDB", myConn, adOpenKeyset, adLockOptimistic

    DBS.AddNew
    DBS!StudentNumber = 1
    DBS!StudentName = "SomeName"
    DBS!Grade = 10

    DBS.AddNew
    DBS!StudentNumber = 2
    DBS!StudentName = "SomeFamilyName"
    DBS!Grade = 10

    DBS.Update
    DBS.Close

    Set DBS = Nothing
    Set myConn = Nothing

End Sub

- С .Fields:


Do While Len(Range("A" & r).Formula) > 0
    With rs
        .AddNew
        .Fields("Commodity #") = Range("A" & r).Value
        .Update
    End With
    r = r + 1   
Loop

- С индексом: Если вы используете числовой индекс полей, то они начинаются с 1 доколичество полей.В вашем случае rst(i) должно быть в порядке, если у вас есть хотя бы i столбцы.В приведенном ниже примере доступно 3 столбца:


For tblRow = 1 To 10
    DBS.AddNew
    For tblCol = 1 To 3
        DBS(tblCol) = "Row: " & tblRow & " Col: " & tblCol
    Next
Next

enter image description here

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