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

 

[jnthree3]

Ahmed:

You are the man! I've been looking for code that does exactly this.

Thank you so much for your hard work.

jnthree3 (Robert)

 

[OriginalAccess]

That will involve derailing a functional Access Application. While I do use AutoExec/AutoOpen(), I would never set it to a static function. Load your variable, and pop up a form to login and ASK user.
Also, your "solution" involves Opening and closing Access multiple times. Why? Once you opened a connection to the DATABASE part, an ".ldb" file is created until you close Excel. YOu can pump the data back and forth to your heart's content.

Then again, I need to grab Excel Market data every 60 seconds - do you propose to start and stop Access that fast? It's not going to work.

Basically, create a connection, and "INSERT". I'll submit the code later today.

 

[OriginalAccess]

I had the same problem. I needed to export 4 columns out of 32. I ended up creating a separate export tab, clearing it copying the data to it:
ThisWorkbook.Worksheets(cstrDataTab).Range(cstrEColCloseValue & clngFirstRow & ":" & cstrEColTime & glngLastRow).Value2 = _
ThisWorkbook.Worksheets(cstrExportTab).Range(cstrColCloseValue & clngFirstRow & ":" & cstrColTime & glngLastRow).Value2
and exporting that tab Ahmed's way

 

[RuiFlora]

Hi Everyone,

The posts here are very useful and solved one my problems.
However, i have formulas in my cells that are not ported to access.

Is it possible to IMPORT and paste with "Values" to get the value from the Excel formula, in access?

Cheers

 

[OriginalAccess]

Hi Everyone,

The posts here are very useful and solved one my problems.
However, i have formulas in my cells that are not ported to access.

Is it possible to IMPORT and paste with "Values" to get the value from the Excel formula, in access?

Cheers

By default only VALUES are exported from Excel to Access. You have to be careful to export correct values, though - you shouldn't export Date into Integer field, for example.

The general code for export would be:

Set cnAccess = CreateObject("ADODB.Connection")
strSource = "[" & strExportTab & "$]" & pstrRange
Set cnAccess = CreateObject("ADODB.Connection")Set cnAccess = CreateObject("ADODB.Connection")
strODBC = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strAccessPath
cnAccess.Open strODBC
strSQL = "INSERT INTO " & gstrExportIntradayTable & " ([SecurityID], [ValueClose], [RecordDate], [TradeVolume]) "
strSQL = strSQL & "SELECT * FROM [Excel 8.0;HDR=YES;DATABASE=" & strWorkbookName & "]." & strSource
cnAccess.Execute strSQL

Adjust variables as needed.

There is no "Paste Values" in Access.

Good luck

 

[RuiFlora]

By default only VALUES are exported from Excel to Access. You have to be careful to export correct values, though - you shouldn't export Date into Integer field, for example.

The general code for export would be:

Set cnAccess = CreateObject("ADODB.Connection")
strSource = "[" & strExportTab & "$]" & pstrRange
Set cnAccess = CreateObject("ADODB.Connection")Set cnAccess = CreateObject("ADODB.Connection")
strODBC = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strAccessPath
cnAccess.Open strODBC
strSQL = "INSERT INTO " & gstrExportIntradayTable & " ([SecurityID], [ValueClose], [RecordDate], [TradeVolume]) "
strSQL = strSQL & "SELECT * FROM [Excel 8.0;HDR=YES;DATABASE=" & strWorkbookName & "]." & strSource
cnAccess.Execute strSQL

Adjust variables as needed.

There is no "Paste Values" in Access.

Good luck

Thanks. I am using the previous piece of code from ahmed_one with no ranges and text cells only.

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 problem is: cells with with "if" formulas with the output "TRUE", "FALSE" or "Brazil" are showing as "1", "0" or "-1" and i would like to keep the text as it is in excel.

 

[RuiFlora]

Thanks. I am using the previous piece of code from ahmed_one with no ranges and text cells only.

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 problem is: cells with with "if" formulas with the output "TRUE", "FALSE" or "Brazil" are showing as "1", "0" or "-1" and i would like to keep the text as it is in excel.

Sorry about this extra post but actually only "-1" and "0" are showing in access, for the TRUE or FALSE.

 

[awill]

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]

came across this and it is working perfectly for me. I am using an Excel form for users to submit; it adds the field values to a single row data table which is then pulled in to Access to append to a database table which in turn adds a SharePoint list item. It seems as though it is functioning, but I've had to add a line to by pass an error I'm receiving on the Excel end. It's a run time 440 automation error and seems to break the code, yet the database and list are still successfully updated. This is very puzzling and I'd like to figure out how to prevent this error, rather than bypassing it under the assumption that it works every time.