Solved: Exporting VBA array to existing Access DB

[arrun]

Dear all, I am looking for some way-out on how to append a new array created in excel through VBA, to a access Table.

Let say I have created following array in VBA

Dim To_Access(5, 3) As Double
Dim i, j As Integer

For i = 1 To 5
For j = 1 To 3
To_Access(i, j) = j
Next j
Next i

Now I need to send this 'To_Access' array to a table names 'Tab1' which is placed in a Access database (.mdb file). And 'Tab1' already have some related data (having 5000 rows and 3 columns).

Can somebody help me out?

Thanks and regards,

[mancubus]

hi.
below procedure;
- adds a temporary worksheet
- transfers the array elements to that sheet,
- updates the access table from range,
- deletes the temporary worksheet

tested (and worked) with XL & Acc 2010.
you have to modify the connection string in procedure for earlier versions.
commented in procedure below line for 2003; NOT TESTED:
'cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & dbFile & ";")



Option Base 1

Sub AddRecsToAccTblFromXL()

'references to:
'X.Xs in 2010 are 2.8. change to your version numbers.
'Microsoft ActiveX Data Objects X.X Library
'Microsoft ActiveX Data Objects Recordset X.X Library
'Microsoft ADO Ext. X.X for DDL and Security

Dim cn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim dbFile As String, dbTbl As String
Dim Recs(5, 3) As Double
Dim i As Long, j As Long
Dim wsTemp As Worksheet

For i = 1 To 5
For j = 1 To 3
Recs(i, j) = j
Next j
Next i

Set wsTemp = Worksheets.Add(after:=Sheets(Sheets.Count))
wsTemp.Range("A1").Resize(UBound(Recs, 1), UBound(Recs, 2)) = Recs

dbFile = "C:\MSO\tests\myDB.accdb" 'change to your DB full name
dbTbl = "Tab1"

Set cn = New ADODB.Connection
cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & dbFile & ";"
'cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & dbFile & ";"

Set rs = New ADODB.Recordset
rs.Open dbTbl, cn, adOpenKeyset, adLockOptimistic, adCmdTable

For i = 1 To wsTemp.Range("A1").End(xlDown).Row
With rs
.AddNew
'change to actual field names in Tab1
.Fields("Field1_Name") = wsTemp.Range("A" & i).Value
.Fields("Field2_Name") = wsTemp.Range("B" & i).Value
.Fields("Field3_Name") = wsTemp.Range("C" & i).Value
.Update
End With
Next i

rs.Close
cn.Close

With Application
.DisplayAlerts = False
wsTemp.Delete
.DisplayAlerts = True
End With

End Sub

[arrun]

Oh great mancubus! I basically tried with 2003 with your suggested modification, and worked fine. Thanks for your help.

[mancubus]

you're wellcome arrun.
glad it helped.