How to solve intermittent login problems with Oracle and VBA's ADODB

250 views Asked by At

My environment is Windows 10, Office 2019 - 64 bit an Oracle Client 19.3. I've had Office Macro's access Oracle data for years. Recently the Oracle server was upgraded from release 11.g to 18.c. The Macro's work on most PC's, but on a few I have intermittent problems logging in to Oracle. I'm wondering if it's because Oracle now has the concept of a "Container". In Oracle's SQL Plus it's called a "Service Name". If I execute the code below using the UserID of "System" I get logged in, but can't see the tables in the container I need (XEPDB1). If I login with a UserID and Password that was created in the XEPDB1 container, I get an error telling me that I have an invalid UserID/Password combination.
Is there a way to use ADODB and specify a Container / Service Name as I log in so that I can avoid login errors? Here's a snippet of the code that I'm using to login.

Option Explicit

Sub ReadFromOracle()
'DECLARE VARIABLES
Dim objConnection           As ADODB.Connection
Dim objRecordset            As ADODB.Recordset
Dim strConnection           As String
Dim strSQL                  As String
Dim lngRecordCount          As Long

On Error GoTo ErrorHandler

Set objConnection = New ADODB.Connection
Set objRecordset = New ADODB.Recordset

strConnection = "Provider=MSDASQL.1;" & _
                "Persist Security Info=False;" & _
                "Data Source=MyServer1;" & _
                "UID=My_XEPDB1_UserID;" & _
                "Password=My_XEPDB1_Password"

strConnection = "Provider=MSDASQL.1;" & _
                "Persist Security Info=False;" & _
                "Data Source=MyServer1;" & _
                "UID=system;" & _
                "Password=My_System_Password"

objConnection.ConnectionString = strConnection

'Open the database connection
objConnection.Open

strSQL = "Select title from LIB_BOOK where book_pk = 1;"

'Close objRecordset if it was open.
If CBool(objRecordset.State And adStateOpen) = True Then
    objRecordset.Close
End If

objRecordset.CursorLocation = adUseClient
objRecordset.Open strSQL, objConnection
lngRecordCount = objRecordset.RecordCount


Exunt:
'Set objects to nothing
'Close objRecordSet
If CBool(objRecordset.State And adStateOpen) = True Then objRecordset.Close
Set objRecordset = Nothing
Set objConnection = Nothing
Exit Sub

ErrorHandler:
'Display the error message

'lngUpdateReturn = Err.Number

Select Case Err.Number

    Case Is = -2147217843
    MsgBox "Detailed Error Message for -2147217843.", vbCritical
    Case Is = -2147467259
    MsgBox "Detailed Error Message for -2147467259.", vbCritical
    Case Else
    MsgBox "Error Number : " & Err.Number & vbNewLine & vbNewLine & _
       "Error Source: " & Err.Source & vbNewLine & vbNewLine & _
       "Error Message : " & Err.Description & vbNewLine & vbNewLine, _
       vbCritical
End Select
GoTo Exunt
End Sub

A subset of the TNSNAMES.ORA file is:

# tnsnames.ora Network Configuration File: C:\app\product\18.0.0\dbhomeXE\NETWORK\ADMIN\tnsnames.ora
# Generated by Oracle configuration tools.
MyServer1 = 
  (DESCRIPTION =
    (ADDRESS = 
      (PROTOCOL = TCP)
      (HOST = MyHost.MyDomain.com)
      (PORT = 1521)
    )
    (CONNECT_DATA =
      (SERVER = DEDICATED)
      (SERVICE_NAME = XEPDB1)
    )
  )
0

There are 0 answers