Excel to Acess via DAO

gapa

New Member
Joined
Jul 3, 2007
Messages
10
Hi,

wondering if someone could help me out here. I have copied this piece of code that will enable you to copy Excel data in Access. The problem is that it is copying cell by cell. Is there a way to modify it so that it can copy the whole row (row 2 to blank) or whole column or even better then whole sheet ?

thanks

Paul

the code is attached below

'------------------
Sub DAOFromExcelToAccess()
' exports data from the active worksheet to a table in an Access database
' this procedure must be edited before use
Dim db As Database, rs As Recordset, r As Long
Set db = OpenDatabase("C:\FolderName\DataBaseName.mdb")
' open the database
Set rs = db.OpenRecordset("TableName", dbOpenTable)
' get all records in a table
r = 3 ' the start row in the worksheet
Do While Len(Range("A" & r).Formula) > 0
' repeat until first empty cell in column A
With rs
.AddNew ' create a new record
' add values to each field in the record
.Fields("FieldName1") = Range("A" & r).Value
.Fields("FieldName2") = Range("B" & r).Value
.Fields("FieldNameN") = Range("C" & r).Value
' add more fields if necessary...
.Update ' stores the new record
End With
r = r + 1 ' next row
Loop
rs.Close
Set rs = Nothing
db.Close
Set db = Nothing
End Sub
 

Some videos you may like

Excel Facts

Shade all formula cells
To shade all formula cells: Home, Find & Select, Formulas to select all formulas. Then apply a light fill color.

Richard Schollar

MrExcel MVP
Joined
Apr 19, 2005
Messages
23,707
Hi

You're pretty much limited to doing it like that. Depending on how many records you are uploading an alternative would be to import the data from Excel to Access, or if you are determined to push the data from Excel to Access, then you could read all the records into a Variant array and process the array record by record rather than cycling thru cells on the worksheet. This would certainly be faster than accessing each cell in the loop.

How many records are you dealing with (approx number)?
 

DonkeyOte

MrExcel MVP
Joined
Sep 6, 2002
Messages
9,123
The below is a (slimmed down / simplified from real) approach I've used in the past to do what you're asking utilising ADO as opposed to DAO ... also the below is pointing at MySQL as opposed to Access so SQL syntax is ever so slightly different.

This post is me merely showing a slightly alternate route, however, Richard is <b>far</b> better placed to help you than I am as I don't have a lot to do with Access.

Richard, I guess putting the row into an array would be quicker ?
Could you provide say a 2 row example do you think ?

Note: the below also creates connection based on a DSN rather than hard coded connection string within VBA itself.

Code:
Sub DAILY_DATA()
'========================================================================================================
'DEFINE VARIABLES
'========================================================================================================
Dim dbname As String                                        'used to hold db name (MySQL)
Dim sqlstr As String                                        'used to hold SQL to be executed (MySQL)
Dim MyConn As ADODB.Connection                              'used for db (MySQL)
Dim MyRS As ADODB.Recordset                                 'used for db (MySQL)
Dim n As Long
'========================================================================================================
'ESTABLISH CONNECTION TO MYSQL
'========================================================================================================
Set MyConn = New ADODB.Connection
MyConn.Open "LOCAL_PUBLIC"
'========================================================================================================
'CREATE SQL AND UPDATE MYSQL WITH RATES FOR TODAY & TOMORROW
'========================================================================================================
'--------------------------------------------------------------------------------------------------------
'Iterate Currency:Currency (load one row at a time)
'--------------------------------------------------------------------------------------------------------
n = 2
Do Until Cells(n, 5) = ""
'--------------------------------------------------------------------------------------------------------
    dbname = "public"
    '-------------------------------------------------------------------------------------------------
    'Create SQL for Today's Rates for Given Currency Code
    '-------------------------------------------------------------------------------------------------
    sqlstr = "INSERT INTO "
        sqlstr = sqlstr & dbname & ".currency_matrix "
    sqlstr = sqlstr & "VALUES ("
        sqlstr = sqlstr & "'" & Cells(n, 3) & "', "
        sqlstr = sqlstr & "'" & Cells(n, 4) & "', "
        sqlstr = sqlstr & "'" & Format(Date, "YYYY-MM-DD") & "', "
        sqlstr = sqlstr & Cells(n, 5) & ", "
        sqlstr = sqlstr & Cells(n, 6) & ", "
        sqlstr = sqlstr & Cells(n, 7) & ", "
        sqlstr = sqlstr & Cells(n, 8) & ", "
        sqlstr = sqlstr & Cells(n, 9) & ", "
        sqlstr = sqlstr & Cells(n, 10) & ", "
        sqlstr = sqlstr & Cells(n, 11) & ", "
        sqlstr = sqlstr & Cells(n, 12) & ", "
        sqlstr = sqlstr & Cells(n, 13) & ", "
        sqlstr = sqlstr & Cells(n, 14) & ", "
        sqlstr = sqlstr & Cells(n, 15) & ", "
        sqlstr = sqlstr & Cells(n, 16) & ", "
        sqlstr = sqlstr & Cells(n, 17) & ", "
        sqlstr = sqlstr & Cells(n, 18) & ", "
        sqlstr = sqlstr & Cells(n, 19) & ", "
        sqlstr = sqlstr & Cells(n, 20) & ", "
        sqlstr = sqlstr & Cells(n, 21) & " "
    sqlstr = sqlstr & ") "
    '-------------------------------------------------------------------------------------------------
    'Log SQL
    '-------------------------------------------------------------------------------------------------
    Cells(n, 22) = sqlstr
    '-------------------------------------------------------------------------------------------------
    'Execute SQL (Today Rates)
    '-------------------------------------------------------------------------------------------------
    Set MyRS = MyConn.Execute(sqlstr)
    '-------------------------------------------------------------------------------------------------
    'Create SQL for Tomorrow's Rates (as per today but incremented date)
    '-------------------------------------------------------------------------------------------------
    sqlstr = Replace(sqlstr, Format(Date, "YYYY-MM-DD"), Format(Date + 1, "YYYY-MM-DD"))
    '-------------------------------------------------------------------------------------------------
    'Execute SQL (Tomorrow Rates)
    '-------------------------------------------------------------------------------------------------
    Set MyRS = MyConn.Execute(sqlstr)
    '-------------------------------------------------------------------------------------------------
'--------------------------------------------------------------------------------------------------------
n = n + 1
'--------------------------------------------------------------------------------------------------------
Loop
'========================================================================================================
'END
'========================================================================================================
MyConn.Close
Set MyRS = Nothing
Set MyConn = Nothing
End Sub
 

Richard Schollar

MrExcel MVP
Joined
Apr 19, 2005
Messages
23,707
Well, I was thinking along the lines of populating a variant array and then processing the elements in the array using AddNew and Update like so:

Code:
'table Data range is A2:G100 say (headers in row 1):
Dim varArray As Variant, i As Long, j As Long
 
varArray = Range("A1:G100").Value
 
For i = 2 to Ubound(varArray,1)   'number of Records (note starting point of row 2)
  rst.AddNew
  For j = 1 to UBound(varArray,2) 'number of fields
    rst.Fields(varArray(1,j) = varArray(i,j)
  Next j
  rst.Update
Next i
 

Fazza

MrExcel MVP
Joined
May 17, 2006
Messages
9,368

ADVERTISEMENT

Hi,

For a worksheet named Sheet1 feeding into table 'MyTable' in 'D:\test\test_db.mdb', see below. Late bound ADO.

If you want, the sheet reference can be to a specific range or a named range. Assumption I've made is that the data has headers in row 1 of the worksheet and data below that.

HTH, Fazza

Code:
Sub demo()
  Dim objRS As Object
  Set objRS = CreateObject("ADODB.Recordset")
 
  objRS.Open "INSERT INTO MyTable SELECT * FROM [Sheet1$] IN '" & ThisWorkbook.FullName & "' 'Excel 8.0;'", _
      "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & "D:\test\test_db.mdb"
 
  Set objRS = Nothing
End Sub
 

Richard Schollar

MrExcel MVP
Joined
Apr 19, 2005
Messages
23,707
Well that looks substantially faster (and definitely more succinct). Does it cause a problem if there is other data than the table to be uploaded in the worksheet?
 

Fazza

MrExcel MVP
Joined
May 17, 2006
Messages
9,368

ADVERTISEMENT

Richard,

Assumption is the data is set up as a table on the worksheet, from row 1 down.

If there is other data, or in other ranges, then the specific range can be set and so other data will not upset it.

Such as, if the data has a familiar named range - but not dynamic named range - the SQL would be "... SELECT * FROM rngName IN ..."

Or a specific range "... FROM [Sheet1$B10:H5000] IN ..."

I've used "SELECT *" but this is just for convenience here. In reality I'd list the field names, so, "SELECT Department, Category, Group, Value" or whatever.

regards, Fazza
 

Fazza

MrExcel MVP
Joined
May 17, 2006
Messages
9,368
You're welcome, Richard.

I used a recordset object for brevity. It could have been one of the other two main ADO objects and just taken an extra line or so. I'm sure I've posted samples in the past.

Also - I was thinking about this as I travelled home - as I have late bound this could equally have been run from MS Word or Outlook or whatever. Just use the actual workbook reference instead of the ThisWorkbook.Fullname. And of course it works also without having Excel or Access open. And with a little more SQL it could pull from multiple Excel worksheets and/or mutliple Excel files all at once.

Beer o'clock here. I'm about to open one right now. Cheers to you too. Regards, Fazza (y)
 

gapa

New Member
Joined
Jul 3, 2007
Messages
10
Thanks to both Richard and Fazza.

Exporting the data is now so much faster.
 

Watch MrExcel Video

Forum statistics

Threads
1,126,986
Messages
5,621,998
Members
415,873
Latest member
fuulhouse

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top