How to call Oracle stored procedure from Excel VBA script?

Question

I have a stored procedure with parameters in an Oracle database.

How do I call it from an Excel VBA script?

Answer 1

There are a lot of plumbing that you need to get in order to get this to work. Try the manual .

It includes this sample. It is assumed that you made the link to ADO, you downloaded the OleDB provider for Oracle, and you created the TNSNames.ora file. If you do not want to use TNSNames.ora, you can try an alternative line

Dim Oracon As ADODB.Connection Dim recset As New ADODB.Recordset Dim cmd As New ADODB.Command Dim param1 As New ADODB.Parameter Dim param2 As New ADODB.Parameter Dim objErr As ADODB.Error Dim Message, Title, Default, DeptValue Message = "Enter a department number (10, 20, or 30)" Title = "Choose a Department" Default = "30" On Error GoTo err_test DeptValue = InputBox(Message, Title, Default) If DeptValue = "" Then Exit Sub If DeptValue < 10 Or DeptValue > 30 Then DeptValue = 30 Set Oracon = CreateObject("ADODB.Connection") Oracon.ConnectionString = "Provider=OraOLEDB.Oracle;" & _ "Data Source=exampledb;" & _ "User ID=scott;" & _ "Password=tiger;" Oracon.Open Set cmd = New ADODB.Command Set cmd.ActiveConnection = Oracon Set param1 = cmd.CreateParameter("param1", adSmallInt, adParamInput, , DeptValue) cmd.Parameters.Append param1 Set param2 = cmd.CreateParameter("param2", adSmallInt, adParamOutput) cmd.Parameters.Append param2 ' Enable PLSQLRSet property Cmd.Properties ("PLSQLRSet") = TRUE cmd.CommandText = "{CALL Employees.GetEmpRecords(?, ?)}" Set recset = cmd.Execute ' Disable PLSQLRSet property Cmd.Properties ("PLSQLRSet") = FALSE Do While Not recset.EOF MsgBox "Number: " & recset.Fields("empno").Value & " Name: " & recset.Fields("ename").Value & " Dept: " & recset.Fields("deptno").Value recset.MoveNext Loop Exit Sub err_test: MsgBox Error$ For Each objErr In Oracon.Errors MsgBox objErr.Description Next Oracon.Errors.Clear Resume Next 

If you have any problems, you can come back and ask a more specific question.

Answer 2

Or you can use the connection manager. Not sure if I can upload .bas files or any files so that you download config.sas configuration file from me ; just use the VBE Import File action to import the downloaded file and copy the contents of WorkExample2 to the new module, and then enter the query between the sRS quotation marks.

Or copy and paste the following into a new module. I provided a lot of usage information at the beginning [so please read], but the database simply installs the file once, after which you do not need to reconfigure it for future use; use ConnectionTest to make sure a stable connection is established, if so, it should debug.print true else false; use WorkExample1 only with SQL Server or Oracle, it just sends a test query and returns the results. As mentioned above, use WorkExample2, use it to handle all your connections, the only thing you will need to change is the location of CopyFromRecordSet and the query string:

  Option Explicit Option Compare Text '######################################################### '# This module contains all connection related variables # '# and handles all the in/out connections. # '######################################################### '### General Usage Notes ### 'This file contains all required variables to handle connections to Oracle DB, MS SQL Server & MS Access 'using the default installed Windows drivers; it shall auto-differentiate between 32/64 bit systems to 'ensure that the correct driver is used and for Oracle, neither a tnsnames.ora nor an Oracle client is required 'to be installed. 'Other databases can be accessed, though third-party ODBC / OLE DB drivers must be obtained and installed; should 'you be using another provider, you shall need to update the ServerProvider Case Statment in all ServerConnectionString 'modules; always ensure that you inlcude a call to Connection_Close to ensure that you close off the connection 'after use. 'Initial setup requires you to setup only that which is relevant to your db setup: '*** Typical Oracle Setup *** 'Servers <Function CnServer>, Databases <Function AppDB>, DBSchema, sSQLUser and sSQLPass '*** Typical SQL Server Setup *** 'Servers <Function CnServer>, Database <MSSDatabase>, Windows Auth: sTrusted = "yes", SQL Auth: sSQLUser & sSQLPass '*** MS Access *** 'Access just requires the MDBPath <full path and filename> and file type (*.mdb) or (*.accdb) as the file is 'a single db 'Dynamic Server Selection (DSS) - use these variables to over-ride your setup defaults for one time connections 'to other servers / db / providers, a typical example would be to default the config file to Oracle but require 'one-time access to SQL Server. '*** DSS Setup *** 'Only those variables that match your server config are required, simply place the variables in your sub; 'unless you have a reason to keep the values, place a call to ClearDSS at the end of your sub 'Also included is a file-open handler for use with data files (txt/csv/xls/xlsx etc) usage is simply based on 'either optionally passing the full path and filename on the function call or if no passed values shall create from the 'GetOpenFileName control 'Additional features include a connection test which simply checks your connection returning True when a 'stable connection is made; a Query Test (WorkingExample2)returning a correctly parsed query if a connection 'is made and a demo of passing a stored proc (WorkingExample1). '*** You can use the sub <WorkingExample2> in all of your connections, just copy and paste into your modules *** '+++ Finally: Usage requires the Microsoft Activex Data Objects Library 2.8 to be set in Tools > References... 'This has been tested with all versions of Excel from 2003 onwards both 32 & 64 bit versions with all versions of 'MS Windows from XP onwards both x86 and x64 '++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 'Section 1: Server Config ' Server Variables - these should not need to be changed Public cnToolConnection As New ADODB.Connection 'This is the connection; hold all connection details Public cnRSDataContainer As ADODB.Recordset 'Holds the retrieved data Public Const ConnectionTimeout As Integer = 15 'Connection Time-out in seconds 999 for unlimited Public Const CommandTimeout As Integer = 240 'Command time-out in seconds 'Server set-up config: Public Const ServerProvider As String = "oracle" 'Proivder type: Oracle; SQLServer; Access; Need Drivers >MySQL; PostGres; TerraData Public Const constServer As Integer = 1 'Oracle server number 1-9; SQL Server 11-19, Local = 99 Public Const constDatabase As String = "m" 'm = MIS, p = Production; MSS uses MSSDatabase; Access uses MDBPath Public Const MSSDatabase As String = "AdventureWorks2008" 'Database for use with SQL Server only Public Const sTrusted As String = "yes" 'Use Windows logon? Yes / No (SQL Server only) Public Const MDBPath As String = "C:\Test1.accdb" 'Access DB path and filename including file-type *.mdb or *.accdb Public Const DefaultFetchHeaders As Boolean = True 'Do you want to fetch column headers? 'User, logon and schema set-up config: Public Const DBSchema As String = "<your schema>" 'DB schema details; SQL Server default: dbo Public Const sSQLUser As String = "<your username>" 'DB login user-name Public Const sSQLPass As String = "<your pass>" 'DB login password '######## Dynamic Server Selection (DSS) ######## 'These variables allow for dynamic selection of server / db at run-time allowing you to choose a different server to 'the default. Usage is to pre-populate all the required fields in this section in your sub '*** IT IS ESSENTIAL THAT YOU RUN [ClearDSS] TO NULL STRING THESE AT THE END OF YOUR SUB *** 'Server set-up config: Public DSSServerProvider As String 'Proivder type: Oracle; SQLServer; MySQL; PostGres; TerraData; Access Public DSSconstServer As String 'True False Public DSSconstDatabase As Boolean 'True uses uses DSSAltDatabase Public DSSAltDatabase As String 'Alternative DB if using Access follow MDBPath guidelines Public DSSsTrusted As String 'Use Windows logon? Yes / No (SQL Server only) Public DSSNoHeaders As Boolean 'Do you want to fetch column headers? 'DSS User, logon and schema set-up config: Public DSSDBSchema As String 'DB schema details Public DSSsSQLUser As String 'DB login user-name Public DSSsSQLPass As String 'DB login password '######## End of DSS Section ######## 'Section 2: VBA Config Public Const ToolVersion As String = "v01_01" 'Prod: v00_00; Dev: v00_00_00 'Set these two at the most appropiate point, usually on a start cmdButton 'Defines both the default workbook (usually this one) and a default worksheet for use with 'their respective collections Public defWSh As Worksheet Public defWBK As Workbook 'Section 3: Any other global variables Public DataUpdatePathAndFileName As String 'path and filename of the data update Public DataUpdateFile As String 'Just the filename of the data update Public DefaultFolderPath As String 'Default primary folder '##### YOU SHOULD NOT NEED TO MODIFY ANYTHING BELOW THIS LINE #### Function cnServer() As String 'Server definition If DSSconstServer <> "" Then cnServer = DSSconstServer Exit Function End If Select Case constServer Case 1: cnServer = "<OracleServer1>" Case 2: cnServer = "<OracleServer2>" Case 3: cnServer = "<OracleServer3>" Case 11: cnServer = "<SQLServer1>" Case 99: cnServer = "(local)" End Select End Function Function AppDB() As String 'Database Selection If DSSconstDatabase = True Then AppDB = DSSAltDatabase Exit Function End If Select Case constDatabase Case "m": AppDB = "MIS" Case "p": AppDB = "Production" Case "MSS": AppDB = MSSDatabase Case "Access": AppDB = MDBPath End Select End Function Function FetchHeaders() As Boolean 'Allows a user to fetch column headers Select Case DSSNoHeaders Case Is = True: FetchHeaders = False Case Is = False Select Case DefaultFetchHeaders Case Is = True: FetchHeaders = True Case Is = False: FetchHeaders = False End Select End Select End Function Function ClearDSS() '### Clears the Dynamic Server Selection after use ### DSSServerProvider = vbNullString DSSconstServer = vbNullString DSSconstDatabase = False DSSAltDatabase = vbNullString DSSsTrusted = vbNullString DSSDBSchema = vbNullString DSSsSQLUser = vbNullString DSSsSQLPass = vbNullString DSSNoHeaders = False Connection_Close End Function Function ServerConnectionString() As String Dim bIs32 As Boolean Dim strOraProvider As String 'Tests the operating system type If InStr(Application.OperatingSystem, "32-bit") Then bIs32 = True 'Due to ODBC changes made by MS between 32/64 bit systems, logic needs to be applied to select the correct Oracle driver Select Case bIs32 Case True: strOraProvider = "msdaora" Case False: strOraProvider = "OraOLEDB.Oracle" End Select If Len(DSSServerProvider) > 0 Then GoTo DssSelector 'Sets the connection string Select Case ServerProvider Case "SQLServer": ServerConnectionString = "Driver={SQL Server};Server=" & cnServer & ";Database=" & _ AppDB & ";Uid=" & sSQLUser & ";Pwd=" & sSQLPass & ";" & _ "Trusted_Connection=" & sTrusted & ";" Case "Oracle": ServerConnectionString = "Provider=" & strOraProvider & ";Data Source=" & cnServer & AppDB & _ ";Persist Security Info=False;User Id=" & sSQLUser & ";Password=" & sSQLPass & ";" Case "Access": ServerConnectionString = "Driver={Microsoft Access Driver (*.mdb, *.accdb)}; Dbq=" & MDBPath & ";" End Select Debug.Print ServerConnectionString Exit Function DssSelector: Select Case DSSServerProvider Case "SQLServer": ServerConnectionString = "Driver={SQL Server};Server=" & cnServer & ";Database=" & _ AppDB & ";Uid=" & DSSsSQLUser & ";Pwd=" & DSSsSQLPass & ";" & _ "Trusted_Connection=" & DSSsTrusted & ";" Case "Oracle": ServerConnectionString = "Provider=" & strOraProvider & ";Data Source=" & cnServer & AppDB & _ ";Persist Security Info=False;User Id=" & DSSsSQLUser & ";Password=" & DSSsSQLPass & ";" Case "Access": ServerConnectionString = "Driver={Microsoft Access Driver (*.mdb, *.accdb)}; Dbq=" & AppDB & ";" End Select Debug.Print ServerConnectionString End Function Function Connection_Open() As ADODB.Connection '### Opens the connection ### Dim conn As ADODB.Connection Set conn = New ADODB.Connection 'Handles Oracles connections - There is an issue between AdoDB and the way Oracle stores its dates 'Meaning that it is near impossible to pass a date in an acceptabe format to Oracle '.Execute "ALTER SESSION SET NLS_DATE_FORMAT = 'DD/MM/YYYY'" Forces Oracle to accept dates in DD/MM/YYYY format If DSSServerProvider = "Oracle" Or ServerProvider = "Oracle" Then ' Initialise connection With conn .ConnectionTimeout = ConnectionTimeout .Open ServerConnectionString .Execute "ALTER SESSION SET NLS_DATE_FORMAT = 'DD/MM/YYYY'" .CommandTimeout = CommandTimeout End With Set Connection_Open = conn Exit Function End If ' Initialise connection With conn .ConnectionTimeout = ConnectionTimeout .Open ServerConnectionString .CommandTimeout = CommandTimeout End With Set Connection_Open = conn End Function Function Connection_Close() '### Closes the connection ### On Error Resume Next If Len(cnToolConnection) <> 0 Then cnToolConnection.Close Set cnToolConnection = Nothing End Function Function TestDBConnection() As Boolean '*** Tests your connection to the db server - useful for connection debug issues *** Dim bIs32 As Boolean Dim strOraProvider As String Dim ServerConnectionString As String On Error GoTo errHandler 'Tests the operating system type If InStr(Application.OperatingSystem, "32-bit") Then bIs32 = True 'Due to ODBC changes made by MS between 32/64 bit systems, logic needs to be applied to select the correct Oracle driver & string Select Case bIs32 Case True: strOraProvider = "msdaora" Case False: strOraProvider = "OraOLEDB.Oracle" End Select 'Sets the connection string Select Case ServerProvider Case "SQLServer": ServerConnectionString = "Driver={SQL Server};Server=" & cnServer & ";Database=" & _ AppDB & ";Uid=" & sSQLUser & ";Pwd=" & sSQLPass & ";" & _ "Trusted_Connection=" & sTrusted & ";" Case "Oracle": ServerConnectionString = "Provider=" & strOraProvider & ";Data Source=" & cnServer & AppDB & _ ";Persist Security Info=False;User Id=" & sSQLUser & ";Password=" & sSQLPass & ";" Case "Access": ServerConnectionString = "Driver={Microsoft Access Driver (*.mdb, *.accdb)}; Dbq=" & MDBPath & ";" End Select cnToolConnection.Open ServerConnectionString If cnToolConnection.State = adStateOpen Then TestDBConnection = True Debug.Print TestDBConnection Debug.Print ServerConnectionString cnToolConnection.Close Set cnToolConnection = Nothing Exit Function errHandler: If Err.Number = "-2147467259" Then TestDBConnection = False Debug.Print TestDBConnection Debug.Print ServerConnectionString End Function Function FileUpdate(Optional FilePath As String) Application.StatusBar = "Refresh underway, Press Esc to Cancel" Application.EnableCancelKey = xlErrorHandler Application.Calculation = xlCalculationManual DefaultFolderPath = ThisWorkbook.Path 'Sets the update file path and filename If Len(FilePath) > 0 Then DataUpdatePathAndFileName = FilePath End If If Len(DataUpdatePathAndFileName) = 0 Or DataUpdatePathAndFileName = False Then DataUpdatePathAndFileName = Application.GetOpenFilename End If If DataUpdatePathAndFileName = False Then MsgBox "You need to select a file to continue", vbExclamation Exit Function End If DataUpdateFile = Mid(DataUpdatePathAndFileName, InStrRev(DataUpdatePathAndFileName, "\") + 1, 999) Call ManualDataUpdate End Function Sub ManualDataUpdate() Dim WS As Worksheet 'Creates and sets the working sheet for data If defWBK Is Nothing Then Set defWBK = Workbooks(ThisWorkbook.Name) WS = defWBK.Sheets.Add WS.Name = "DataImport" 'Opens the data-file and copies the contents to the newly created DataImport sheet 'in rediness for "fixing" Workbooks.Open DataUpdatePathAndFileName Cells.Copy Destination:=WS.Range("A1") Windows(DataUpdateFile).Close savechanges:=False Call FixRawData(WS) End Sub Function FixQry(sInput As String) 'adoDB cannot parse the semi-colon character therefore all query strings 'are passed through this to first remove accidental inclusions so as to prevent the 'ORA-00911 - whilst this error is thrown for other types of invalid adoDB characters, 'the semi-colon used to terminate statements is the most common. If Right(sInput, 1) = ";" Then FixQry = Left(sInput, Len(sInput) - 1) Exit Function End If FixQry = sInput End Function Sub zLibrary_Use() '### Contains directions on using this library with an example ### Dim sRS As String 'Holds the query / proc executable '*** Place your other db code here: 'Handles connection and stored proc 'OPTION 1 - Executes a simple proc: sRS = "[" & DBSchema & ".uspStoredProcName_" & ToolVersion & "]" Set cnRSDataContainer = Connection_Open.Execute(sRS) 'Executes proc 'OPTION 2 - Executes a proc with variables: Set cnRSDataContainer = Connection_Open.Executeprocedure(DBSchema & ".uspStoredProcName_" & ToolVersion, _ "varOne", strOne, "varTwo", strTwo, "varThree", strThree, "varFour", strFour, _ "varFive", strFive) '*** Place your other tool code here: Sheet1.Range("A1").CopyFromRecordset cnRSDataContainer Connection_Close 'Closes the connection Set cnRSDataContainer = Nothing End Sub Sub WorkingExample1() Application.ScreenUpdating = False Application.DisplayAlerts = False '### This is a working example of a script execution ### Dim sRS As String Dim WS As Worksheet If defWBK Is Nothing Then Set defWBK = Workbooks(ThisWorkbook.Name) For Each WS In Worksheets If WS.Name = "ConnectionTest" Then WS.Delete End If Next Set WS = defWBK.Sheets.Add WS.Name = "ConnectionTest" Select Case ServerProvider Case "SQLServer": sRS = "Select 'ExecuteTest:Successful'" Case "Oracle": sRS = "Select 'ExecuteTest:Successful' From Dual" End Select Debug.Print sRS Set cnRSDataContainer = Connection_Open.Execute(sRS) WS.Range("A1").CopyFromRecordset cnRSDataContainer Set WS = Nothing Set defWBK = Nothing End Sub Sub Working_Example2() Application.ScreenUpdating = False Application.DisplayAlerts = False '### This is a working example of a script execution ### Dim sRS As String Dim WS As Worksheet Dim iCols As Integer If defWBK Is Nothing Then Set defWBK = Workbooks(ThisWorkbook.Name) For Each WS In Worksheets If WS.Name = "ConnectionTest" Then WS.Delete End If Next Set WS = defWBK.Sheets.Add WS.Name = "ConnectionTest" sRS = "Select * From <Enter a table here - make sure its less than 60k rows>" Debug.Print sRS Set cnRSDataContainer = Connection_Open.Execute(FixQry(sRS)) 'Do you want column headers? False = Default, True = No DSSNoHeaders = False 'Copies the data from the recordset based on whether headers are required Select Case FetchHeaders Case Is = True: For iCols = 0 To cnRSDataContainer.Fields.Count - 1 WS.Cells(1, iCols + 1).Value = cnRSDataContainer.Fields(iCols).Name WS.Range("A1").EntireRow.Font.Bold = True Next WS.Range("A2").CopyFromRecordset cnRSDataContainer Case Is = False: WS.Range("A1").CopyFromRecordset cnRSDataContainer End Select WS.Cells.EntireColumn.AutoFit Set WS = Nothing Set defWBK = Nothing Connection_Close End Sub