Làm cách nào để gọi thủ tục lưu sẵn Oracle từ tập lệnh Excel VBA?

Question

Tôi có một thủ tục lưu sẵn với các tham số trong cơ sở dữ liệu Oracle.

Làm cách nào để gọi từ bên trong tập lệnh VBA Excel?

Answer 1

Có rất nhiều hệ thống ống nước bạn phải làm đúng để có được điều này để làm việc. Hãy thử số này guide.

Nó bao gồm mẫu này. Nó giả sử bạn đã thực hiện một tham chiếu đến ADO, bạn đã tải về nhà cung cấp OleDB cho Oracle, và bạn đã thiết lập tệp TNSNames.ora. Nếu bạn không muốn sử dụng tnsnames.ora bạn có thể thử một sự thay thế 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 

Nếu bạn gặp vấn đề, bạn có thể quay trở lại và đặt một câu hỏi cụ thể hơn.

Answer 2

Hoặc bạn có thể sử dụng trình quản lý kết nối. Không chắc liệu tôi có thể tải lên các tệp .bas hay bất kỳ tệp nào để bạn có thể download the connections config .bas file from me; chỉ cần sử dụng hành động Nhập tệp của VBE để nhập tệp đã tải xuống và sao chép nội dung của WorkingExample2 vào mô-đun mới rồi nhập truy vấn của bạn giữa các dấu ngoặc kép của sRS.

Hoặc sao chép và dán phần sau vào Mô-đun mới. Tôi đã cung cấp rất nhiều thông tin sử dụng ngay từ đầu [vì vậy xin vui lòng đọc] nhưng cơ sở chỉ đơn giản là thiết lập các tập tin một lần sau đó bạn không cần phải cấu hình lại để sử dụng trong tương lai; sử dụng ConnectionTest để kiểm tra xem kết nối ổn định có được thực hiện hay không, nếu có, nó sẽ debug.print true false; sử dụng WorkingExample1 chỉ với SQL Server hoặc Oracle, điều này chỉ đơn giản là gửi một truy vấn thử nghiệm và trả về kết quả. Như đã đề cập ở trên, sử dụng WorkingExample2, sử dụng nó để xử lý tất cả các kết nối của bạn những điều duy nhất bạn sẽ cần phải sửa đổi là vị trí của CopyFromRecordSet và chuỗi truy vấn:

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