How do I call an Oracle stored procedure from an Excel VBA script?
Solution 1:
There's a lot of plumbing you have to get right in order to get this to work. Try this guide.
It includes this sample. It assumes you've made a reference to ADO, you've downloaded the OleDB provider for Oracle, and you've set up the TNSNames.ora file. If you don't want to use TNSNames.ora you can try an alternative connection string
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 run into problems you can come back and ask a more specific question.
Solution 2:
Or you can use a connections manager. Not sure whether I can upload .bas files, or any files so you can download the connections config .bas file from me; simply use the Import File action of the VBE to import the downloaded file and copy the contents of WorkingExample2 to a new module then enter your query between the quotes of sRS.
Or, copy and paste the following to a new Module. I have provided plenty of usage info at the beginning [so please read] but the basis is simply setup the file once then you need not reconfigure for future use; use ConnectionTest to check that a stable connection is made, if so, it shall debug.print true else false; use WorkingExample1 only with SQL Server or Oracle, this simply sends a test query and returns the results. As mentioned above, use WorkingExample2, use it to handle all of your connections the only things you would need to modify is the location of the 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's / 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