Я бы сделал, например, так - на DAO (исполняется в Excel):

 

Sub fromExcelToAccess()

    Dim dbe As Object 'DAO.DBEngine

    Dim db  As Object 'DAO.Database

    Dim rst As Object 'DAO.Recordset

    Dim i As Long

       

    Set dbe = CreateObject("DAO.DBEngine.120")

    Set db = dbe.OpenDatabase("C:\...\file.accdb")

    Set rst = db.TableDefs("ИмяТаблицы").OpenRecordset

       

    For i = 1 To 10 'цикл по записям Excel

        rst.AddNew

            rst("Поле1").Value = "первое поле из Excel"

            rst("Поле2").Value = "второе поле из Excel"

            rst("Поле3").Value = "третье поле из Excel"

        rst.Update

    Next

       

End Sub

Можно и на более модерновом ADO, но DAO мне исторически ближе. И меньше буковок получается в плане "строки подключения"

 

Для файлов c расширением mdb можно использовать Set dbe = CreateObject("DAO.DBEngine.36"). Это по поводу универсальности.

 

Не в чистом виде универсально, в силу ограничений провайдеров данных (не может Jet работать с xls? при Access mdb, ACE тут все яднее).

Public Sub AddNew()

    'Если хотя бы один из файлов 2007-2010, то

    'Const sConn As String = "Provider=Microsoft.ACE.OLEDB.12.0;Mode=Share Deny None;Data Source=c:\sap\db.accdb"

    Const sConn As String = "Provider=Microsoft.Jet.OLEDB.4.0;;Mode=Share Deny None;Data Source=c:\sap\db.mdb"

    Dim AddSQL As String

    Dim pConn As Object, AddRSet As Object, TableRSet As Object

    Set pConn = CreateObject("ADODB.Connection"): pConn.Open sConn

    'Поменять на Excel 12.0 для версий файлов 2007-2010 (путь и имя файла с импортируемыми в Access значениями)

    AddSQL = "Select t1.[Дата],t1.[Название],t1.[Данные] From [Excel 8.0;DATABASE=c:\SAP\book1.xls;HDR=YES].[Sheet1$] As t1"

    'Заменить TableName на название таблицы в Access

    AddSQL = AddSQL & " Left Join TableName As t2 On ((t1.[Дата]=t2.[Дата]) And (t1.[Название]=t2.[Название]) And (t1.[Данные]=t2.[Данные]))"

    AddSQL = AddSQL & " Where t2.[Дата] Is Null"

    Set AddRSet = CreateObject("ADODB.Recordset"): AddRSet.CursorLocation = 3

    AddRSet.Open AddSQL, pConn, 3, 1

    If AddRSet.RecordCount = 0 Then

        MsgBox "Нет новых записей"

    Else

        Set TableRSet = CreateObject("ADODB.Recordset"): TableRSet.CursorLocation = 3

        'Заменить TableName на название таблицы в Access

        TableRSet.Open "Select [Дата],[Название],[Данные] From TableName Where [Дата] Is Null", pConn, 3, 3

        Do Until AddRSet.EOF

            TableRSet.AddNew

            TableRSet("Дата").Value = AddRSet("Дата").Value

            TableRSet("Название").Value = AddRSet("Название").Value

            TableRSet("Данные").Value = AddRSet("Данные").Value

            AddRSet.MoveNext

        Loop

        TableRSet.Update

        TableRSet.Close

    End If

    AddRSet.Close: pConn.Close

End Sub

 

Начал с кода Константина, потому что его код визуально меньше

 

Подправил с учётом расположений файлов, получилось так:

 

Sub fromExcelToAccess()

    Dim dbe As Object 'DAO.DBEngine

    Dim db  As Object 'DAO.Database

    Dim rst As Object 'DAO.Recordset

    Dim i As Long

       

    Set dbe = CreateObject("DAO.DBEngine.120")

    Set db = dbe.OpenDatabase("C:\...\Test.accdb")

    Set rst = db.TableDefs("Таблица1").OpenRecordset

       

    For i = 1 To Range("A" & Cells.Rows.Count).End(xlUp).Row - 1

            rst.AddNew

            rst("Поле1").Value = Range("a" & 1 + i).Value

            rst("Поле2").Value = Range("b" & 1 + i).Value

            rst("Поле3").Value = Range("c" & 1 + i).Value

        rst.Update

    Next

       

End Sub

 

 

Код работает правильно, но позволяет заливать одинаковые данные сколько угодно раз. Как этого избежать?

 

Сделать поле1 и поле2 в Access ключевыми

 

ну и в коде надо будет еще Update обернуть обработкой ошибки:

    On Error Resume Next

    rst.Update

    On Error GoTo 0

Я так обычно делаю, а кто-то в начале процедуры пишет только первый оператор.

 

Например, такой перебор записей набора с учетом фильтра (WHERE):

 

Sub traverseRecordset()

    Dim dbe As Object 'DAO.DBEngine

    Dim db  As Object 'DAO.Database

    Dim rst As Object 'DAO.Recordset

       

    Set dbe = CreateObject("DAO.DBEngine.120")

    Set db = dbe.OpenDatabase("C:\...\file.accdb")

    Set rst = db.OpenRecordset("SELECT * FROM Таблица1 WHERE 1=1")

       

    Do While Not rst.EOF 'цикл по записям

   

        'бла-бла-бла: что-то делаем с очередной записью

        'например, "трогаем" значение первого поля

        Debug.Print rst.Fields(0).Value

       

        rst.MoveNext

    Loop

       

End Sub

 

Цитата

Я думал что можно как-то сверять данные на листе и данные в БД блоком

 

В виде SQL запроса можно, как вариант к версии, выбирающий записи в таблице и листе по совпадению трёх полей

 

 

    ExistsSQL = "Select t1.[Дата],t1.[Название],t1.[Данные] From [Excel 8.0;DATABASE=c:\SAP\book1.xls;HDR=YES].[Sheet1$] As t1"

    ExistsSQL = ExistsSQL & " Inner Join TableName As t2 On ((t1.[Дата]=t2.[Дата]) And (t1.[Название]=t2.[Название]) And (t1.[Данные]=t2.[Данные]))"

    Set ExistsRSet = CreateObject("ADODB.Recordset"): ExistsRSet.CursorLocation = 3

    ExistsRSet.Open ExistsSQL, pConn, 3, 1

    If ExistsRSet.RecordCount > 0 Then

        Set pSheet = ActiveWorkbook.Worksheets

        pSheet.Range("A1:C1").Value = Array("Дата", "Название", "Данные")

        pSheet.Range("A2").CopyFromRecordset ExistsRSet

        MsgBox "Создан лист дубликатов"

    End If

    ExistsRSet.Close

 

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

 

По поводу первичного ключа. У вас же товар приходит по какой-то накладной или нечто подобное. Её и можно добавить в качестве элемента ключа: дата, название, накладная.

Или вариант: дата, название, время ввода в таблицу.

Или некоторое строковое значение - код ввода, получаемое как запрос к FileSystemObject.GetTempName: дата, название, кодВвода

 

Public Function GetPKey()

    Dim fso As Object, sKey As String

    Set fso = CreateObject("Scripting.FileSystemObject")

    sKey = fso.GetTempName

    GetPKey = Mid$(sKey, 1, Len(sKey) - 4)

End Function

 

Хочу обратить внимание, что метод CopyFromRecordset объекта Range работает и в случае DAO (а не только ADO):

 

 

Цитата

Excel Developer Reference

Range.CopyFromRecordset Method

Copies the contents of an ADO or DAO Recordset object onto a worksheet, beginning at the upper-left corner of the specified range.

 

 

Поэтому можно отобранные аксессные строки выгрузить на лист Excel:

 

Sub fromRecordset()

 

    Dim dbe As Object 'DAO.DBEngine

    Dim db  As Object 'DAO.Database

    Dim rst As Object 'DAO.Recordset

       

    Set dbe = CreateObject("DAO.DBEngine.120")

    Set db  = dbe.OpenDatabase("C:\...\file.accdb")

    Set rst = db.OpenRecordset("SELECT * FROM Таблица1 WHERE 1=1")

    Range("A1").CopyFromRecordset rst         

       

End Sub

 

А потом просто операцией присваивания передать диапазон выгрузки в массив VBA - ну, а дальше уже, как говорится, дело техники и фантазии.