如何从 Excel VBA 脚本调用 Oracle 存储过程？

Question

我在 Oracle 数据库中有一个带有参数的存储过程。

如何在 Excel VBA 脚本中调用它？

Answer 1

为了让它发挥作用，您必须做好很多管道工作。试试这个guide。

它包括这个样本。它假定您已经引用了 ADO，您已经下载了 Oracle 的 OleDB 提供程序，并且您已经设置了 TNSNames.ora 文件。如果您不想使用 TNSNames.ora，您可以尝试替代 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

如果您遇到问题，可以回来提出更具体的问题。

Answer 2

或者您可以使用连接管理器。不确定我是否可以上传 .bas 文件或任何文件，以便您可以download the connections config .bas file from me；只需使用 VBE 的 Import File 操作导入下载的文件并将 WorkingExample2 的内容复制到新模块，然后在 sRS 的引号之间输入您的查询。

或者，将以下内容复制并粘贴到新模块。我在一开始就提供了大量的使用信息[所以请阅读]，但基础只是设置文件一次，然后您无需重新配置以供将来使用；使用 ConnectionTest 检查是否建立了稳定的连接，如果是，则应 debug.print true else false;仅对 SQL Server 或 Oracle 使用 WorkingExample1，这只是发送一个测试查询并返回结果。 如上所述，使用 WorkingExample2，使用它来处理所有连接，您唯一需要修改的是 CopyFromRecordSet 的位置和查询字符串：

    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