Access VBA with MSSQL Server - Passing Parameter via VBA code to MSSQL SQL SERVER query

Access VBA with MSSQL Server - Passing Parameter via VBA code to MSSQL SQL SERVER query

As a Part of Consulting Life, you never knew what projects you will be working so from an open source world to Microsoft world here is a quick little transition story.



Tasks Explored

Migrate Access to SQL server

on that, the first task is to demonstrate access VBA code can  pass a parameter to SQL query using ADODB connection string.


FYI : SSMA Wont work with SQL 2009 R2 as its EOF so have to live with precision Manual Migration.


What was used

• MSSQL server 2008 r2 or any
• access 2010 or any
• firewall exceptions for 1433 added, named pipes enabled.
• MSSQL server Pubs database with standard stored proc

Reference

https://docs.microsoft.com/en-us/sql/ado/reference/ado-api/append-and-createparameter-methods-example-vb?view=sql-server-2017

VBA Code

'BeginAppendVB 

    'To integrate this code 

    'replace the data source and initial catalog values 

    'in the connection string 

Public Sub Main() 

    On Error GoTo ErrorHandler 

    'recordset, command and connection variables 

    Dim Cnxn As ADODB.Connection 

    Dim cmdByRoyalty As ADODB.Command 

    Dim prmByRoyalty As ADODB.Parameter 

    Dim rstByRoyalty As ADODB.Recordset 

    Dim rstAuthors As ADODB.Recordset 

    Dim strCnxn As String 

    Dim strSQLAuthors As String 

    Dim strSQLByRoyalty As String 

     'record variables 

    Dim intRoyalty As Integer 

    Dim strAuthorID As String 

    ' Open connection 

    Set Cnxn = New ADODB.Connection 

    strCnxn = "Provider='sqloledb';Data Source='MySqlServer';" & _ 

        "Initial Catalog='Pubs';Integrated Security='SSPI';" 

    Cnxn.Open strCnxn 

    ' Open command object with one parameter 

    Set cmdByRoyalty = New ADODB.Command 

    cmdByRoyalty.CommandText = "byroyalty" 

    cmdByRoyalty.CommandType = adCmdStoredProc 

    ' Get parameter value and append parameter 

    intRoyalty = Trim(InputBox("Enter royalty:")) 

    Set prmByRoyalty = cmdByRoyalty.CreateParameter("percentage", adInteger, adParamInput) 

    cmdByRoyalty.Parameters.Append prmByRoyalty 

    prmByRoyalty.Value = intRoyalty 

    ' Create recordset by executing the command 

    Set cmdByRoyalty.ActiveConnection = Cnxn 

    Set rstByRoyalty = cmdByRoyalty.Execute 

    ' Open the Authors Table to get author names for display 

    ' and set cursor client-side 

    Set rstAuthors = New ADODB.Recordset 

    strSQLAuthors = "Authors" 

    rstAuthors.Open strSQLAuthors, Cnxn, adUseClient, adLockOptimistic, adCmdTable 

    ' Print recordset adding author names from Authors table 

    Debug.Print "Authors with " & intRoyalty & " percent royalty" 

    Do Until rstByRoyalty.EOF 

        strAuthorID = rstByRoyalty!au_id 

        Debug.Print "   " & rstByRoyalty!au_id & ", "; 

        rstAuthors.Filter = "au_id = '" & strAuthorID & "'" 

        Debug.Print rstAuthors!au_fname & " " & rstAuthors!au_lname 

        rstByRoyalty.MoveNext 

    Loop 

    ' clean up 

    rstByRoyalty.Close 

    rstAuthors.Close 

    Cnxn.Close 

    Set rstByRoyalty = Nothing 

    Set rstAuthors = Nothing 

    Set Cnxn = Nothing 

    Exit Sub 

ErrorHandler: 

    ' clean up 

    If Not rstByRoyalty Is Nothing Then 

        If rstByRoyalty.State = adStateOpen Then rstByRoyalty.Close 

    End If 

    Set rstByRoyalty = Nothing 

    If Not rstAuthors Is Nothing Then 

        If rstAuthors.State = adStateOpen Then rstAuthors.Close 

    End If 

    Set rstAuthors = Nothing 

    If Not Cnxn Is Nothing Then 

        If Cnxn.State = adStateOpen Then Cnxn.Close 

    End If 

    Set Cnxn = Nothing 

    If Err <> 0 Then 

        MsgBox Err.Source & "-->" & Err.Description, , "Error" 

    End If 

End Sub 

'EndAppendVB

Database : Microsoft Pubs

Stored proc definition

CREATE PROCEDURE [dbo].[byroyalty] @percentage int

AS

select au_id from titleauthor

where titleauthor.royaltyper = @percentage

Connection String

    ' Open connection

    Set Cnxn = New ADODB.Connection

    strCnxn = "Provider=SQLOLEDB; Data Source=localhost;Database=pubs;Trusted_Connection=Yes;"

    Cnxn.Open strCnxn

Viola It works !