'=============================================================================================

'##### Загрузка массива в таблицу Access DAO

'FnExcelToAccessDAO oDb, aTemp

'---------------------------------------------------------------------------------------------

Function FnExcelToAccessDAO(ByVal oDb As DAO.Database, _

                        ByVal vData As Variant, _

                        ByVal strTblName As String)

'    Dim dbe As Object 'DAO.DBEngine

'    Dim db  As Object 'DAO.Database

    Dim pRSet As Object 'DAO.Recordset

'    Dim pRSetEmpty As Object

    Dim i As Long

       

    Dim ilastRow As Long: ilastRow = UBound(vData)

    Dim ilastCol As Long: ilastCol = UBound(vData, 2)

 

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

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

 

On Error Resume Next

 

    Set pRSet = oDb.TableDefs(strTblName).OpenRecordset

'    Set pRSetEmpty = oDb.TableDefs("Name").OpenRecordset

   

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

'        If Len(vData(i + 1, 4)) > 0 Then

            pRSet.AddNew

                For j = 0 To ilastRow

                    pRSet(j).Value = vData(j, i)

                Next j

            pRSet.Update

    Next

End Function

'=============================================================================================

 

 

 

'#####=============================================================================================

'Загрузка массива в таблицу Access DAO

'FnExcelToAccessDAO oDb, aTemp

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Function FnExcelToAccessDAO(ByVal oDb As DAO.Database, _

                        ByVal vData As Variant)

'    Dim dbe As Object 'DAO.DBEngine

'    Dim db  As Object 'DAO.Database

    Dim pRSet As Object 'DAO.Recordset

    Dim pRSetEmpty As Object

    Dim i As Long

       

    Dim ilastRow As Long: ilastRow = UBound(vData)

    Dim ilastCol As Long: ilastCol = UBound(vData, 2)

 

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

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

 

On Error Resume Next

 

    Set pRSet = oDb.TableDefs("Name").OpenRecordset

    Set pRSetEmpty = oDb.TableDefs("Name").OpenRecordset

   

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

        If Len(vData(i + 1, 4)) > 0 Then

            pRSet.AddNew

                For j = 0 To ilastCol - 1

                    pRSet(j).Value = vData(i + 1, j + 1)

                Next j

            pRSet.Update

        Else

            vData(i + 1, 4) = 0

            pRSetEmpty.AddNew 'добавление в таблицу с пустыми номерами

                For j = 0 To ilastCol - 1

                    pRSetEmpty(j).Value = vData(i + 1, j + 1)

                Next j

            pRSetEmpty.Update

        End If

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

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

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

            

    Next

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

'        If Len(vData(i + 1, 4)) > 0 Then

'            pRSet.AddNew

'            pRSet(0).Value = vData(i + 1, 1)

'            pRSet(1).Value = vData(i + 1, 2)

'            pRSet(2).Value = vData(i + 1, 3)

'            pRSet(3).Value = vData(i + 1, 4)

'            pRSet(4).Value = vData(i + 1, 5)

'            pRSet(5).Value = vData(i + 1, 6)

'            pRSet(6).Value = vData(i + 1, 7)

'            pRSet(7).Value = vData(i + 1, 8)

'            pRSet(8).Value = vData(i + 1, 9)

'            pRSet(9).Value = vData(i + 1, 10)

'            pRSet(10).Value = vData(i + 1, 11)

'            pRSet(11).Value = vData(i + 1, 12)

'            pRSet(12).Value = vData(i + 1, 13)

'            pRSet(13).Value = vData(i + 1, 14)

'            pRSet(14).Value = vData(i + 1, 15)

'

'            pRSet.Update

'        Else

'            vData(i + 1, 4) = 0

'            pRSetEmpty.AddNew 'добавление в таблицу с пустыми номерами

'            pRSetEmpty(0).Value = vData(i + 1, 1)

'            pRSetEmpty(1).Value = vData(i + 1, 2)

'            pRSetEmpty(2).Value = vData(i + 1, 3)

'            pRSetEmpty(3).Value = vData(i + 1, 4)

'            pRSetEmpty(4).Value = vData(i + 1, 5)

'            pRSetEmpty(5).Value = vData(i + 1, 6)

'            pRSetEmpty(6).Value = vData(i + 1, 7)

'            pRSetEmpty(7).Value = vData(i + 1, 8)

'            pRSetEmpty(8).Value = vData(i + 1, 9)

'            pRSetEmpty(9).Value = vData(i + 1, 10)

'            pRSetEmpty(10).Value = vData(i + 1, 11)

'            pRSetEmpty(11).Value = vData(i + 1, 12)

'            pRSetEmpty(12).Value = vData(i + 1, 13)

'            pRSetEmpty(13).Value = vData(i + 1, 14)

'            pRSetEmpty(14).Value = vData(i + 1, 15)

'

'            pRSetEmpty.Update

'        End If

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

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

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

'

'    Next

       

End Function

'=============================================================================================

 

 

 

'#####=============================================================================================

'Загрузка массива в таблицу Access DAO

'FnExcelToAccessDAO oDb, aTemp

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Function FnExcelToAccessDAO(ByVal oDb As DAO.Database, _

                        ByVal vData As Variant)

'    Dim dbe As Object 'DAO.DBEngine

'    Dim db  As Object 'DAO.Database

    Dim pRSet As Object 'DAO.Recordset

    Dim i As Long

       

    Dim ilastRow As Long: ilastRow = UBound(vData)

    Dim ilastCol As Long: ilastCol = UBound(vData, 2)

 

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

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

 

On Error Resume Next

 

    Set pRSet = oDb.TableDefs("Name").OpenRecordset

       

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

        pRSet.AddNew

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

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

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

           

        pRSet(0).Value = vData(i + 1, 1)

        pRSet(1).Value = vData(i + 1, 2)

        pRSet(2).Value = vData(i + 1, 3)

        pRSet(3).Value = vData(i + 1, 4)

        pRSet(4).Value = vData(i + 1, 5)

        pRSet(5).Value = vData(i + 1, 6)

        '

        pRSet(6).Value = vData(i + 1, 7)

        pRSet(7).Value = vData(i + 1, 8)

        pRSet(8).Value = vData(i + 1, 9)

        pRSet(9).Value = vData(i + 1, 10)

        pRSet(10).Value = vData(i + 1, 11)

        pRSet(11).Value = vData(i + 1, 12)

        pRSet(12).Value = vData(i + 1, 13)

        pRSet(13).Value = vData(i + 1, 14)

        pRSet(14).Value = vData(i + 1, 15)

        pRSet.Update

    Next

       

End Function

'=============================================================================================