Using Excel VBA to Export data to Ms.Access Table

[ahmed_one]

I am current using following code to export data from worksheet to Ms.Access database, the code is looping through each row and insert data to Ms.Access Table.

Public Sub TransData()

Application.ScreenUpdating = False
Application.EnableAnimations = False
Application.EnableEvents = False
Application.DisplayAlerts = False


ActiveWorkbook.Worksheets("Folio_Data_original").Activate


Call MakeConnection("fdMasterTemp")

For i = 1 To rcount - 1
rs.AddNew
rs.Fields("fdName") = Cells(i + 1, 1).Value
rs.Fields("fdDate") = Cells(i + 1, 2).Value
rs.Update

Next i


Call CloseConnection


Application.ScreenUpdating = True
Application.EnableAnimations = True
Application.EnableEvents = True
Application.DisplayAlerts = True


End Sub


Public Function MakeConnection(TableName As String) As Boolean
'*********Routine to establish connection with database

Dim DBFullName As String
Dim cs As String

DBFullName = Application.ActiveWorkbook.Path & "\FDData.mdb"

cs = "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & DBFullName & ";"

Set cn = CreateObject("ADODB.Connection")

If Not (cn.State = adStateOpen) Then
cn.Open cs
End If

Set rs = CreateObject("ADODB.Recordset")

If Not (rs.State = adStateOpen) Then

rs.Open TableName, cn, adOpenKeyset, adLockOptimistic

End If

End Function




Public Function CloseConnection() As Boolean
'*********Routine to close connection with database

On Error Resume Next
If Not rs Is Nothing Then
rs.Close
End If


If Not cn Is Nothing Then
cn.Close

End If
CloseConnection = True
Exit Function


End Function

Above code works fine for few hundred lines of records, but apparently it will be more data to export, Like 25000 records, is it possible to export without looping through all records and just one SQL INSERT statement to bulk insert all data to Ms.Access Table in one go?

Any help will be much appreciated.

Thanks

Ahmed

 

[Ruddles]

You can set up an ADODB connection to your open workbook and treat a named range within it as a table, something like this:-

  Dim rsConn As ADODB.Connection
  Dim strConnect As String
  
  Set rsConn = New ADODB.Connection
  strConnect = "Provider=Microsoft.Ace.OLEDB.12.0;" & _
              "Data Source=" & ThisWorkbook.FullName & ";" & _
              "Extended Properties=Excel 12.0;"
  rsConn.Open strConnect

Then assuming your named range in Excel is called myTable, you run an INSERT query which appends myTable to your Access table, something like this:-

INSERT INTO myAccessTable ( fdName, fdDate) SELECT myTable.fdName, myTable.fdDate FROM myTable;

Play around with that...

 

[ahmed_one]

Thanks for your reply, In your code we are making connection with Excel file, but how to let the code know, that we need to insert data in Ms.Access database??? Following line of code will make connection with Excel file and make the connection open:

rsConn.Open strConnect

but then there is no way we can execute the Insert statement against Ms.Access database??

May be I am a bit confuse but please if you can provide a simple example to play for me. Thanks

Ahmed

You can set up an ADODB connection to your open workbook and treat a named range within it as a table, something like this:-

  Dim rsConn As ADODB.Connection
  Dim strConnect As String
  
  Set rsConn = New ADODB.Connection
  strConnect = "Provider=Microsoft.Ace.OLEDB.12.0;" & _
              "Data Source=" & ThisWorkbook.FullName & ";" & _
              "Extended Properties=Excel 12.0;"
  rsConn.Open strConnect

Then assuming your named range in Excel is called myTable, you run an INSERT query which appends myTable to your Access table, something like this:-

INSERT INTO myAccessTable ( fdName, fdDate) SELECT myTable.fdName, myTable.fdDate FROM myTable;

Play around with that...

 

[Ruddles]

You're right, sorry, I just logged back in to tell you to ignore my previous post. I'm afraid I don't know how to access tables from different connections in the same SQL query. I don't know what I was thinking. Sorry to have wasted your time.

I don't know if it's possible. Perhaps someone else can suggest...

 

[ahmed_one]

No problem....it's ok.....I hope I will get the reply soon from others

 

[Ruddles]

Or you could drive it from the Access end. Access allows you to connect to multiple databases concurrently.

 

[ahmed_one]

Actually, the requirements is to use the Excel as a Frontend, and Access as Backend...That is why the process needs to be operate through Excel.

 

[xenou]

I would probably "pull from Access" rather than "push from Excel". You can still run this from Excel using automation. It is generally advisable to query closed workbooks, though to what extent this is absolutely necessary I don't know. So I would go about it this way:

1. Copy the worksheet you are moving data from to a temp file location (here I am using an xls file as the temp file, but you could use any format you like - text, csv, xml, xlsx, and so on).
2. Run a function in Access to import the data.
3. That's all. But do be sure the data you put in the temp file is "clean" - a simple grid of the relevant data with no weird things like blank rows or other data in the file. The header must match the headers in your table in Access. If necessary you may need to "clean up" the data so that it is in good form. Access imports will require this or your data import might fail.

For Example:

IN EXCEL

[COLOR="Navy"]Sub[/COLOR] Foo()
[COLOR="Navy"]Dim[/COLOR] wb [COLOR="Navy"]As[/COLOR] Workbook
[COLOR="Navy"]Dim[/COLOR] AC [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Object[/COLOR]
[COLOR="Navy"]Dim[/COLOR] ret [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Byte[/COLOR]
[COLOR="Navy"]Const[/COLOR] SAVE_PATH [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR] = "C:\myTemp\AccessUpload.xls"
    
    [COLOR="SeaGreen"]'//Save data as an xls file[/COLOR]
    Worksheets("Sheet1").Copy
    [COLOR="Navy"]Set[/COLOR] wb = ActiveWorkbook
    Application.DisplayAlerts = False
    [COLOR="Navy"]If[/COLOR] CreateObject("Scripting.FileSystemObject").FileExists(SAVE_PATH) [COLOR="Navy"]Then[/COLOR]
        Kill SAVE_PATH
    [COLOR="Navy"]End[/COLOR] [COLOR="Navy"]If[/COLOR]
    wb.SaveAs SAVE_PATH, 56 [COLOR="SeaGreen"]'//56 => Excel 2003 File Format (xls) [see http://www.rondebruin.nl/win/s5/win001.htm][/COLOR]
    wb.Close False
    Application.DisplayAlerts = True
    
    [COLOR="SeaGreen"]'//Import Spreadsheet[/COLOR]
    [COLOR="SeaGreen"]'//Note: Must set Access macro settings so that Access doesn't warn about macros when it opens[/COLOR]
    [COLOR="Navy"]Set[/COLOR] AC = CreateObject("Access.Application")
    [COLOR="Navy"]With[/COLOR] AC
        .OpenCurrentDatabase "C:\myTemp\db1.mdb", False
        ret = .Run("GetXLData")
    [COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]

[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

IN ACCESS (public function in a standard module):

[COLOR="Navy"]Public[/COLOR] [COLOR="Navy"]Function[/COLOR] GetXLData() [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Byte[/COLOR]
[COLOR="Navy"]Dim[/COLOR] ret [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Byte[/COLOR]

    [COLOR="Navy"]On[/COLOR] [COLOR="Navy"]Error[/COLOR] [COLOR="Navy"]GoTo[/COLOR] ErrHandler
    ret = 1
    DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel8, "Table1", "C:\myTemp\AccessUpload.xls", True
    ret = 0
    
ErrHandler:
GetXLData = ret
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Function[/COLOR]

 

[Ruddles]

Possibly... In Excel, open the Access database; set the database up to execute a form on startup; use the form's timer to execute a query which does the import; then have the query close Access when it's finished running.

 

[ahmed_one]

Dear All,

A lots of thanks for helping me regarding my problem, while the solutions provided are remarkable, I've managed to solve the issue by doing lots of search. For those who are looking for something similar, I am posting here the code which is work for me to export data from Excel to Access by issuing SQL Insert command, and this is lighting fast also, please modify the code as per your requirements:

Public Sub DoTrans()


Set cn = CreateObject("ADODB.Connection")
dbPath = Application.ActiveWorkbook.Path & "\FDData.mdb"
dbWb = Application.ActiveWorkbook.FullName
dbWs = Application.ActiveSheet.Name
scn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & dbPath
dsh = "[" & Application.ActiveSheet.Name & "$]"
cn.Open scn
ssql = "INSERT INTO fdFolio ([fdName], [fdOne], [fdTwo]) "
ssql = ssql & "SELECT * FROM [Excel 8.0;HDR=YES;DATABASE=" & dbWb & "]." & dsh



cn.Execute ssql


End Sub

The code inserts 58647 records in approx. 6 seconds!!!

Hope this will help someone....Also if anyone like to improve the code like instead of using "Select *" we can use field names(I've already tried different variations of field names like putting field name b/w square brackets etc etc but with no luck so far...)..

Thanks all of you for great help

Best regards

Ahmed