MyTetra Share
Делитесь знаниями!
Загрузка массива в таблицу Access DAO
16.03.2019
23:43
Текстовые метки: vba, DAO, Recordset
Раздел: !Закладки - VBA - Access - DAO

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

'##### Загрузка массива в таблицу 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("PEIN_EmptySkid").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("PEIN").OpenRecordset

Set pRSetEmpty = oDb.TableDefs("PEIN_EmptySkid").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("PEIN").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

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

Так же в этом разделе:
 
MyTetra Share v.0.52
Яндекс индекс цитирования