Using an existing external data connection to create a recordset

Question

I have a macro that I use to get data from an Access database, pass it into a recordset and then drop it into a worksheet in a crosstab format. Currently all my data starts in a SQL Server, gets pulled into Access, and then my macro takes it from there.
I’m trying to cut Access out of the process. What I need is the code to point at an external data source rather than to an Access mdb, which results in me getting the same recordset for the rest of the macro to process. My whole code is below; I’ve marked the part I’m looking to change.

' Gets the prior incurred claims estimates data from the Access database
' "RestatedIncurredClaims.mdb" in the same folder as the model, and sets up
' the tables on the Prior_Claims sheet to contain the data.
Public Sub GetPriorClaimsData()
    If [MODEL_NAME] = "" Then
        Dim modelName As String
        modelName = Replace(ThisWorkbook.Name, "ReserveModel_", "")
        modelName = Left(modelName, InStr(modelName, ".") - 1)
        [MODEL_NAME] = modelName
    End If


   ' WANT TO CHANGE THIS PART

Dim dbPath As String
dbPath = ThisWorkbook.Path & "\RestatedIncurredClaims.mdb"

Application.Calculation = xlCalculationManual

On Error GoTo priorClaimsErr

Application.StatusBar = "Opening prior claims database..."

' Open the database
' Options:=False means non-exclusive, see:
' http://msdn.microsoft.com/en-us/library/office/ff835343.aspx
Dim db As Database
Set db = Workspaces(0).OpenDatabase(Name:=dbPath, _
    Options:=False, ReadOnly:=True)

Application.StatusBar = "Getting prior claims data..."

' Execute query to get prior incurred claim estimates for this model only
Dim rs As Recordset
Set rs = db.OpenRecordset( _
    "SELECT * FROM [Restated incurred claims] WHERE [model_name] = """ _
        & [MODEL_NAME] & """")

' WANT TO LEAVE EVERYTHING ELSE THE SAME


Dim i As Long, numCellsFound As Long
Dim iLOB As Long, iTOS As Long, iReported As Long, iIncurred As Long
numCellsFound = 0

' Create the array that will hold the prior claims data during processing
Dim priorClaimsData() As Variant
ReDim priorClaimsData( _
    0 To [PRIOR_CLAIMS_TABLES].Rows.Count - 1, _
    0 To [PRIOR_CLAIMS_TABLES].Columns.Count - 1)

If rs.RecordCount > 0 Then

    Application.StatusBar = "Clearing prior claims data..."
    [PRIOR_CLAIMS_TABLES].ClearContents

    Dim lookupLOB As New Dictionary
    For i = 1 To [LST_LINES].Cells.Count
        lookupLOB([LST_LINES].Cells(i).Value) = i
    Next

    Dim lookupTOS As New Dictionary
    For i = 1 To [LST_TYPES_SHORT].Cells.Count
        lookupTOS([LST_TYPES_SHORT].Cells(i).Value) = i
    Next

    Dim lookupDate As New Dictionary
    For i = 1 To [PRIOR_CLAIMS_DATES].Cells.Count
        lookupDate([PRIOR_CLAIMS_DATES].Cells(i).Value) = i
    Next

    rs.MoveFirst
    Do Until rs.EOF
        If rs.AbsolutePosition Mod 1000 = 0 Then
            Application.StatusBar = "Processing prior claims data, row " _
                & Format(rs.AbsolutePosition, "#,0") & "..."
        End If

        iLOB = lookupLOB(CStr(rs!model_lob))
        iTOS = lookupTOS(CStr(rs!fnc_ben_typ_cd))
        iReported = lookupDate(CStr(rs!acct_perd_yr_mo))
        iIncurred = lookupDate(CStr(rs!clm_incr_yr_mo))

        If iLOB <> 0 And iTOS <> 0 _
            And iReported <> 0 And iIncurred <> 0 Then

            iLOB = iLOB - 1
            iTOS = iTOS - 1
            iReported = iReported - 1
            iIncurred = iIncurred - 1
            priorClaimsData( _
                iLOB * ROWS_PER_LOB + iIncurred, _
                iTOS * COLS_PER_TOS + iReported) = rs!rst_incur_clm
            numCellsFound = numCellsFound + 1
        End If

        rs.MoveNext
    Loop

    [PRIOR_CLAIMS_TABLES].Value = priorClaimsData

End If

If numCellsFound = 0 Then
    MsgBox Prompt:="No prior estimates data found for this model (" _
            & [MODEL_NAME] & ").", _
        Title:="Warning", _
        Buttons:=vbExclamation + vbOKOnly
End If

GoTo closeDb

priorClaimsErr:
    MsgBox Prompt:="Failed to update the prior claim estimates data:" _
        & vbCrLf & vbCrLf & Err.Description, _
    Title:="Warning", _
    Buttons:=vbExclamation + vbOKOnly

closeDb:
    Application.StatusBar = "Closing prior claims database..."

If Not rs Is Nothing Then
    rs.Close
    Set rs = Nothing
End If

If Not db Is Nothing Then
    db.Close
    Set db = Nothing
End If

Application.StatusBar = "Recalculating..."

Application.Calculation = xlCalculationAutomatic
Application.StatusBar = False
End Sub

I initially thought that if I established the data connection and had it saved in an .odc file, that referencing that file in vba would be simple. But all I’ve been able to find is code for establishing new data connections directly in vba with a connection string. Is this what I have to do? If so is there a way to do it so that the code will work regardless of the user running it?

I'm using Excel 2010

Thanks

Is the SQL Server table a linked table, or do you plan to use ADO to query the server and return the recordset? — DataWriter, Mar 09 '18 at 15:24
I'm not 100% sure, but I think I want to query the server and return the recordset. — Diver49, Mar 09 '18 at 15:28
Google ADO and look at www.connectionstrings.com these will help you here — Nathan_Sav, Mar 09 '18 at 15:30
If you do create and use a linked table, you would query and return the recordset in much the same way you would a local Access table. If you want to do it in ADO, you need to create a connection object that links to the server (using a SQL Server connection string) and then use a command or recordset object to return the data. Are you familiar with ADO? — DataWriter, Mar 09 '18 at 15:30
I'm only familiar with ADO from researching this question, based on what I read I wasn't sure if ADO was what I was looking for. I have connected to the table I need when creating a pivot table and I thought I could just use the same connection to populate a recordset in vba. — Diver49, Mar 09 '18 at 15:37
Have a look here: https://stackoverflow.com/a/1122214/7599798 — FunThomas, Mar 09 '18 at 15:38
I don't use Access but; If you are pulling SQL data into Access, vba code to pull SQL data should be in the Access code. — GMalc, Mar 09 '18 at 16:12

score 0 · Accepted Answer · 2018-03-09T21:16:22.417

This is an ADO code sample you can use to connect to SQL Server: You must add a reference to 'Microsoft ActiveX Data Objects 6.1' first

SQLSERVER_CONN_STRING = "Provider=SQLOLEDB.1;Data Source=<server name or IP address>;User ID=<User_id>;Password=<pwd>;Initial Catalog=<initial cat>;"


Dim oConn As ADODB.Connection
Dim rs as ADODB.Recorset
Dim sSQL as String

Set oConn = New ADODB.Connection
oConn.CommandTimeout = 60
oConn.ConnectionTimeout = 30

oConn.Open SQLSERVER_CONN_STRING

Set rs = New ADODB.Recordset
'note that SQL Server query syntax is different!
sSql = "SELECT * FROM [Restated incurred claims] WHERE [model_name] = '" & [MODEL_NAME] & "'")

rs.Open sSQL, oConn, adOpenStatic, adLockOptimistic, adCmdText
If Not rs Is Nothing Then
  If rs.State = 1 Then
    If rs.RecordCount > 0 Then

       <your code here>

    end if
  End If
End If

If Not rs Is Nothing Then 
    If rs.State = 1 Then rs.Close
End if

If Not oConn Is Nothing Then 
    If oConn.State = 1 Then oConn.Close
End if

Using an existing external data connection to create a recordset

1 Answers1