Import table from SQL to Access using Excel VBA

Question

I have an Excel tool for doing actuarial calculations on data from SQL. The tool imports the table from SQL to my Excel book then does some calculations on the data set.

I want to take the table from SQL (I use CopyFromRecordSet to paste into my spreadsheet) and rather insert that table into an Access db.

    Dim acc As Object
    Dim TblName As String, DBName As String, scn As String
    
    Set acc = CreateObject("Access.Application")
    Set rs = New ADODB.Recordset
       
    scn = ThisWorkbook.Worksheets("AXIS Tables").Range("A3").Value

    DBName = ThisWorkbook.Worksheets("AXIS Tables").Range("B3").Value

    Call CreateConnectionSQL.CreateConnectionSQL

    acc.OpenCurrentDatabase ActiveWorkbook.Path & "\" & scn & "\Input.accdb"
    
    rs.ActiveConnection = cn
    rs.CursorType = adOpenForwardOnly
    rs.LockType = adLockReadOnly
    rs.Source = "SELECT * FROM" DBName
    rs.Open
    
    
    TblName = "SAM"
    
    Call DoCmd.TransferDatabase(TransferType:=acImport, _
                            databaseName:=rs, _
                            ObjectType:=acTable, _
                            Source:=rs.Fields, _
                            Destination:=acc)
    
    rs.Close
    Call CreateConnectionSQL.CloseConnectionACC
    acc.CloseCurrentDatabase
    acc.Quit
    Set acc = Nothing

I tried a plethora of methods, I spent dozens of hours googling. I assume that RecordSet is a virtual database in Excel where the data is stored. I want to dump that data into a new table in Access.

I assume Call CreateConnectionSQL.CreateConnectionSQL creates a connection to a remote database and you want to export the results of the query SELECT * FROM DBName to a new table in an existing local Access Database called Input.accdb. Is that correct ? What should the name of the new table be ? — CDP1802
Thank you for your response, yes. I created a reusable sub for calling a ADO connection to our sql server. the select query is the passthrough to the sql server, it's a sample query because the actually query build is quite complex in building it due to renaming columns and multiplying by negatives etc. Yes, the "Input.accdb" is the local access database I want to put that table. The name of the table should be "AXIS" — Kal-El M.
Are you able to create a sheet on the excel to hold the SELECT results temporarily before transferring to access database. ? Are any of the fields dates, is so what format are they ? — CDP1802
Yes, so currently what I do is pull the information into a spreadsheet temporarily then use the DoCmd.transferspreadsheet to get it into the access dbs. The issue with this method I have found is that the dbs tend to be like 50% - 100% larger in size (27mb becoming 54mb) than if I manually download the sql table into Access, and queried the tables in Access to the format I wanted. — Kal-El M.

CDP1802 CDP1802 · Accepted Answer · 2020-11-15T13:00:44

Create a sheet called AXIS in your workbook to hold the query results before importing into Access.

Option Explicit

Sub CopyToAccess()

    Const TABLENAME As String = "AXIS"
    Const SHEETNAME As String = "AXIS" ' create this sheet
    Const SQL As String = "SELECT * FROM TABLE1"

    Dim acc As Object, cn As ADODB.Connection, rs As ADODB.Recordset
    Dim rng As Range, ws As Worksheet
    Dim sPath As String, sAddr As String, n As Long, i As Integer
    Dim scn As String, dbname As String, dbpath As String
    
    sPath = ThisWorkbook.Path
    With ThisWorkbook.Worksheets("AXIS Tables")
      scn = .Range("A3").Value
      dbname = .Range("B3").Value
    End With
    dbpath = sPath & "\" & scn & "\" & dbname
    
    ' connect and query sql database
    Set cn = CreateConnectionSQL
    Set rs = New ADODB.Recordset
    rs.ActiveConnection = cn
    rs.CursorType = adOpenForwardOnly
    rs.LockType = adLockReadOnly
    rs.Source = SQL
    rs.Open

    ' clear sheet
    Set ws = ThisWorkbook.Worksheets(SHEETNAME)
    ws.Cells.Clear
    
    ' set field names as header
    For i = 1 To rs.Fields.Count
       ws.Cells(1, i) = rs(i - 1).Name
    Next
    
    ' copy record set to sheet
    ws.Range("A2").CopyFromRecordset rs
    Set rng = ws.Range("A1").CurrentRegion
    n = rng.Rows.Count - 1
    sAddr = ws.Name & "!" & rng.AddressLocal
    sAddr = Replace(sAddr, "$", "") ' remove $ from address
    
    MsgBox n & " records imported to " & sAddr, vbInformation
    cn.Close

    ' open ACCESS
    Set acc = CreateObject("Access.Application")
    acc.OpenCurrentDatabase dbpath
    
    ' clear out any existing table
    On Error Resume Next
    acc.DoCmd.DeleteObject acTable, TABLENAME
    On Error GoTo 0
    
    ' export sheet into access
    acc.DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, TABLENAME, _
    sPath & "/" & ThisWorkbook.Name, True, sAddr
       
    ' finish
    acc.CloseCurrentDatabase
    acc.Quit
    Set acc = Nothing
    MsgBox "Export to " & dbpath & " table " & TABLENAME & " complete", vbInformation
    
End Sub

Function CreateConnectionSQL() As ADODB.Connection

    Const SERVER As String = "server"
    Const DB As String = "database"
    Const UID As String = "user"
    Const PWD As String = "password"
    
    Dim sConStr As String
    sConStr = "Driver={SQL Server Native Client 11.0};Server=" & SERVER & _
              ";Database=" & DB & ";Uid=" & UID & ";Pwd=" & PWD & ";"
    
    'Debug.Print sConStr
    Set CreateConnectionSQL = CreateObject("ADODB.Connection")
    CreateConnectionSQL.Open sConStr
    
End Function

Import table from SQL to Access using Excel VBA

1 Answers