Erlandsen Data Consulting

Erlandsen Data Consulting
1 de 3
http://www.erlandsendata.no/english/index.php?d=envbadacexportado
Export data from Excel to Access (ADO)

If you want to export data to an Access table from an Excel worksheet, the
macro example below shows how this can be done:
Sub ADOFromExcelToAccess()
' exports data from the active worksheet to a table in an Access database
' this procedure must be edited before use
Dim cn As ADODB.Connection, rs As ADODB.Recordset, r As Long
' connect to the Access database
Set cn = New ADODB.Connection
cn.Open "Provider=Microsoft.Jet.OLEDB.4.0; " & _
"Data Source=C:\FolderName\DataBaseName.mdb;"
' open a recordset
Set rs = New ADODB.Recordset
rs.Open "TableName", cn, adOpenKeyset, adLockOptimistic, adCmdTable
' 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
cn.Close
Set cn = Nothing
End Sub
The macro example assumes that your VBA project has added a reference to
the ADO object library.
You can do this from within the VBE by selecting the menu Tools, References
and selecting Microsoft ActiveX Data Objects x.x Object Library.
Use ADO if you can choose between ADO and DAO for data import or export.
Below is an extended example that shows how you can export data
from multiple workbooks:
Sub ExportMultipleFiles()
Dim fn As Variant, f As Integer
Dim cn As ADODB.Connection
' select one or more files
fn = Application.GetOpenFilename("Excel-files,*.xls", _
1, "Select One Or More Files To Open", , True)
If TypeName(fn) = "Boolean" Then Exit Sub
' connect to the Access database
Set cn = New ADODB.Connection
On Error GoTo DisplayErrorMessage
cn.Open "Provider=Microsoft.Jet.OLEDB.4.0; " & _
"Data Source=C:\FolderName\DataBaseName.mdb;"
On Error GoTo 0
If cn.State <> adStateOpen Then
Exit Sub
End If
Application.ScreenUpdating = False
' repeat for each selected file
For f = LBound(fn) To UBound(fn)
Debug.Print "Selected file #" & f & ": " & fn(f)
Application.StatusBar = "Exporting data from " & fn(f) & "..."
ExportFromExcelToAccess cn, CStr(fn(f))
Application.StatusBar = False
Next f
Application.ScreenUpdating = True
' close the database connection
cn.Close
Set cn = Nothing
13/01/2015 10:42 p.m.
2 de 3
cn.Close
Set cn = Nothing
MsgBox "The data export has finished!", vbInformation, ThisWorkbook.Name
Exit Sub
DisplayErrorMessage:
MsgBox Err.Description, vbExclamation, ThisWorkbook.Name
Resume Next
End Sub
Sub ExportFromExcelToAccess(cn As ADODB.Connection, strFullFileName As String)
' exports data from a workbook to a table in an Access database
' this procedure must be edited before use
Dim wb As Workbook, rs As ADODB.Recordset, r As Long, f As Integer
If cn Is Nothing Then Exit Sub
If cn.State <> adStateOpen Then Exit Sub
' open the source workbook
Set wb = Workbooks.Open(strFullFileName, True, True)
On Error GoTo 0
If wb Is Nothing Then Exit Sub ' failed to open the workbook
' activate the proper data source worksheet
wb.Worksheets(1).Activate
' create a new recordset
Set rs = New ADODB.Recordset
' open a recordset, all records in a table
rs.Open "TableName", cn, adOpenKeyset, adLockOptimistic, adCmdTable
' or open an empty recordset using a sql query that returns no records
'rs.Open "select * from TableName where SomeFieldName = -1", _
'
cn, adOpenKeyset, adLockOptimistic, adCmdText
On Error GoTo 0
If rs.State = adStateOpen Then ' successfully opened the recordset
r = 2 ' the first row containing data in the worksheet
Do While Len(Range("A" & r).Formula) > 0
' repeat until the first empty cell in column A
With rs
.AddNew ' create a new record
' add values to each field in the record
For f = 1 To .Fields.Count
.Fields(f - 1).Value = Cells(r, f).Value
Next f
.Update ' stores the new record
End With
r = r + 1 ' next row
Loop
rs.Close
End If
Set rs = Nothing
' close the source workbook without saving any changes
wb.Close False
Exit Sub
DisplayErrorMessage:
MsgBox Err.Description, vbExclamation, ThisWorkbook.Name
Resume Next
End Sub
Document last updated 2005-02-01 20:32:10
Printer friendly version
User Contributed Comments (in descending order):

Ole P. from Norway wrote (2006-11-16 08:58:12 CET):
Re: Delete previous data in the table

Depending on your SQL database type, something like this should work:
strSQL = "delete * from tablename" ' replace tablename
' or: strSQL = "truncate tablename" ' replace tablename
cn.Execute strSQL
The connection variable cn must be opened with write access and the user must have the
proper rights to delete data from the table.
ALF from USA wrote (2006-11-16 00:40:55 CET):
Delette previous data in the table

Wow, this is great.
This adds the data to an existing table, what if I want to replace the content of the table each
13/01/2015 10:42 p.m.
3 de 3
Wow, this is great.
This adds the data to an existing table, what if I want to replace the content of the table each
time I run the Macro (In other word, delette all the data in the table before I run this macro).
Thank you.
Re: Export from Excel to Access

You can run SQL commands to create a new table, e.g. like this:
strSQL = "CREATE TABLE tablename ("
strSQL = strSQL & "LastName varchar, "
strSQL = strSQL & "FirstName varchar, "
strSQL = strSQL & "Address varchar, "
strSQL = strSQL & "Age int "
strSQL = strSQL & ")"
cn.Execute strSQL
You can learn more about SQL at W3 Schools.
Gene Davis from Everett, Washington wrote (2006-09-10 02:04:10 CET):
Export from Excel to Access

This works great for exporting to an existing table in Access. How do I modify this solution to
create a NEW table in Access from an Excel spreadsheet, complete with column headings?
Similar to the 'Transfer Spreadsheet' action in Access.
Thanks
Vic from Johannesburg, South Africa wrote (2006-06-09 16:26:09 CET):
Big up guys
This a great site
Mahesh from Bangalore, India wrote (2006-06-02 15:41:18 CET):
Wonderfull code
This is really a wonderfull site
Shep from Lincoln, UK wrote (2006-05-23 11:41:40 CET):
Brilliant!
This worked perfectly. Thanks for your help.
Re: Great stuff. Used lots of information from here but. . .?

You can use SQL statements to update a table with multiple records, e.g. like this:
insert into TableName1 select * from TableName2 where SomeField = 'dummy'
ADO also supports a batch update mode where you can update all record changes at once,
and rollback if the update fails. Using this method you will still have to add, change or delete
one record at the time in your code, before you finally submit the changes to the database.
You will find lots of examples if you search Google Groups for "ADO adLockBatchOptimistic"
Barry ( iwrk4dedpr ) from Colorado Springs, CO, USA wrote (2006-02-16 19:48:13 CET):
Great stuff. Used lots of information from here but. . .?

Most of your examples involve using data on a worksheet to update a database, and it would
seem that it is one record at a time. I've found another site ( XL-Dennis ) that showed me
how to import en masse from excel to Access. But now I'm wondering.
I'm attempting to get away from excel. So let's say I have an array of information ( existing
in memory only ) how can I use that array to update the database? Some arrays may be
quite huge so I'd like to not do this 1 record at a time.
Shar wrote (2005-11-30 06:22:25 CET):
Error while opening workbook

I am using the code to export data from excel file to access database. When the control
comes to the following line in ExportFromExcelToAccess sub, it does not do anything, but
automatically goes to the beginning of macro.
Set wb = Workbooks.Open(strFullFileName, True, True)
Please let me know what could be wrong.
13/01/2015 10:42 p.m.

Erlandsen Data Consulting

Uploaded by

Copyright:

Available Formats

Erlandsen Data Consulting

Uploaded by

Document Information

Copyright

Available Formats

Share this document

Share or Embed Document

Sharing Options

Did you find this document useful?

Is this content inappropriate?

Copyright:

Available Formats

Erlandsen Data Consulting

Uploaded by

Copyright:

Available Formats

Erlandsen Data Consulting

Export data from Excel to Access (ADO)

13/01/2015 10:42 p.m.