Solved: Transfer range from excel to access

[ndendrinos]

Hello
I use this code to transfer one row of data from Excel to Access
What I need is to convert the code to work with a selection as there are several rows
I need to transfer and would like to do this by running the code once.


Sub Auto_close()
' exports data from the active worksheet to a table in an Access database

Dim cn As ADODB.Connection, rs As ADODB.Recordset
' connect to the Access database

Set cn = New ADODB.Connection
cn.Open "Provider=Microsoft.Jet.OLEDB.4.0; " & _
"Data Source=C:\Documents and Settings\nick dendrinos\Desktop\vault.mdb;"
' open a recordset
Set rs = New ADODB.Recordset
rs.Open "invoices", cn, adOpenKeyset, adLockOptimistic, adCmdTable

With rs
.AddNew ' create a new record
' add values to each field in the record
.Fields("name") = Range("A2").Value
.Fields("total") = Range("B2").Value
.Fields("date") = Range("C2").Value
.Update ' stores the new record
End With

rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing



End Sub

BTW : your answer if any will also help JAHoff who has just started at MrExcel or maybe you can help him directly by following this link http://www.mrexcel.com/board2/viewtopic.php?t=261910&highlight=

Many thanks

[geekgirlau]

Sub Auto_close()
' exports data from the active worksheet to a table in an Access database
Dim cn As ADODB.Connection, rs As ADODB.Recordset
Dim lngRow As Long


' connect to the Access database
Set cn = New ADODB.Connection

cn.Open "Provider=Microsoft.Jet.OLEDB.4.0; " & _
"Data Source=C:\Documents and Settings\nick dendrinos\Desktop\vault.mdb;"

' open a recordset
Set rs = New ADODB.Recordset
rs.Open "invoices", cn, adOpenKeyset, adLockOptimistic, adCmdTable

' loop through selected range
For lngRow = 1 To Selection.Rows.Count
With rs
.AddNew ' create a new record
' add values to each field in the record
.Fields("name") = rng.Cells(lngRow, 1).Value
.Fields("total") = rng.Cells(lngRow, 2).Value
.Fields("date") = rng.Cells(lngRow, 3).Value
.Update ' stores the new record
End With
Next lngRow

rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing
End Sub

[Bob Phillips]

Dim oRow As Range

With rs
For Each oRow In Selection.Rows
.AddNew ' create a new record
' add values to each field in the record
.Fields("name") = Range("A" & oRow.Row).Value
.Fields("total") = Range("B" & oRow.Row).Value
.Fields("date") = Range("C" & oRow.Row).Value
.Update ' stores the new record
Next oRow
End With

[ndendrinos]

Thank you both
geekgirlau I get an error with your code
xld your code works but doubles up (my mistake I'm sure)

Please see attachments

[Bob Phillips]

It only added once for me. You must have run the macro twice.

[ndendrinos]

Tried it several times always doubles up.
Did you try my sample or made your own?
I must have done a mistake when introducing your edit in the original code
Thank you again

[ndendrinos]

xld:

Dim cn As ADODB.Connection, rs As ADODB.Recordset
' connect to the Access database

Took out the : , rs As ADODB.Recordset

Was left with : Dim cn As ADODB.Connection
' connect to the Access database

... and it works..... Am I compouding the mistake here or is this OK ?

Thank you

[Bob Phillips]

Tried it several times always doubles up.
Did you try my sample or made your own?
I must have done a mistake when introducing your edit in the original code
Thank you again

No I tried yours.

I deleted the data from the database, then ran the code. Just two rows added.

[Bob Phillips]

xld:

Dim cn As ADODB.Connection, rs As ADODB.Recordset
' connect to the Access database

Took out the : , rs As ADODB.Recordset

Was left with : Dim cn As ADODB.Connection
' connect to the Access database

... and it works..... Am I compouding the mistake here or is this OK ?

Thank you

That should be irrelevant, and is not good programming.

The only way I could (seemingly) get it to double up was to open the database and the table in Access, and then run the code. Looking at the table at that point seemed that the update didn't happen, so close the table down, run the code again, and open the table and it is doubled up. But the firts code run actually took, so it was still a double run of the code.

[ndendrinos]

XLD ... doubles still BUT I changed the macro name from Sub Auto_Close
to Sub test()
and now the code works fine.
If you think that the title of the macro had anything to do with doubling up the transfer (on close) as I was closing the excel file before checking the table ( and I think this is what your last remark ment) then I will mark it "solved" with many thanks.
Regards,
Nick