ODBC Connection to 2 Oracle Servers

[JW61]

I use some code (below) that I found on this site to establish and refresh an ODBC connection to Oracle server/tables. And it works great.

The problem I have is that I need to connect to two different Oracle servers using different login ID's.

Using the information below I login to the FINANCE server and access any information.

UID = myId
PWD = myPwd
ODBCtable = apps_Ap_table
LocalTable = apps_Ap_table
DSN = Oracle
DBQ = FINANCE

And:

UID = MFG_ID
PWD = password
ODBCtable = PO_Items
LocalTable = PO_Items
DSN = Oracle
DBQ = MFG

When I try to access the MFG server/tables I get the following message:

After I use the code to refresh the tables/password of either server for the first time and then try link to the other sever, I get the below error message:

"Microsoft Jet database could not find the object"
"Make sure the object exists and that you spell its name and path correctly."

The only way I have found around this is to completely exit Access and reopen the database and I can then login into the second server.

Can someone help me?
Thanks,
JW

Function CreateODBCLinkedTables(txtTable As String) As Boolean
   On Error GoTo CreateODBCLinkedTables_Err
   Dim strTblName As String, strConn As String, strODBCtable As String
   Dim db As DAO.Database, rs As DAO.Recordset, tbl As DAO.TableDef
   Dim strDSN As String
   Dim I As Integer
   Dim RefreshLink As Boolean
   ' ---------------------------------------------
   ' Register ODBC database(s).
   ' ---------------------------------------------
   RefreshLink = False
   Set db = CurrentDb
   Set rs = db.OpenRecordset("Select * From " & txtTable & " Order By DSN,ODBCTableName;")
   For I = 0 To rs.Fields.Count - 1
        If rs(I).Name = "Refresh" Then RefreshLink = True
   Next

   With rs
      While Not .EOF
      If RefreshLink = True Then If rs!Refresh = False Then GoTo NextRecord
         strDSN = rs("DSN")
      ' ---------------------------------------------
      ' Link table.
      ' ---------------------------------------------
         strTblName = rs("LocalTableName")
         strConn = "ODBC;"
         strConn = strConn & "DSN=" & rs("DSN") & ";"
         strConn = strConn & "DBQ=" & rs("DBQ") & ";"
         strConn = strConn & "DATABASE=" & rs("DataBase") & ";"
         strConn = strConn & "UID=" & rs("UID") & ";"
         strConn = strConn & "PWD=" & rs("PWD") & ";"
         strConn = strConn & "ASY=" & rs("ASY") & ";"
         strConn = strConn & "TABLE=" & rs("ODBCTableName")
         If (DoesTblExist(strTblName) = False) Then
            Set tbl = db.CreateTableDef(strTblName, _
                          dbAttachSavePWD, rs("ODBCTableName"), _
                          strConn)
            db.TableDefs.Append tbl
         Else
            Set tbl = db.TableDefs(strTblName)
            tbl.Connect = strConn
            tbl.RefreshLink
         End If
NextRecord:
         rs.MoveNext
      Wend
  End With
  CreateODBCLinkedTables = True
CreateODBCLinkedTables_End:
    Set tbl = Nothing
    Set rs = Nothing
    Set db = Nothing
    Exit Function
   
CreateODBCLinkedTables_Err:
    If Err.Number = 13 Then Err.Clear
    MsgBox Err.Description, vbCritical, "MyApp"
    Resume Next
End Function

 

[SkipVought]

Hi,

Here's something that I use to query an Oracle and DB2 database, with related data...

Sub GetData()
    Dim rPN As Range, lRow As Long, iCol As Integer
    Dim sSQL(1) As String, sServer As String
    Dim rst(1) As ADODB.Recordset, cnn(1) As ADODB.Connection, fld As ADODB.Field
    Const DW_ = 0
    Const DB2 = 1
    
    Set cnn(DW_) = New ADODB.Connection
    Set cnn(DB2) = New ADODB.Connection

    sServer = "DWPROD"
    cnn(DW_).Open "Driver={Microsoft ODBC for Oracle};" & _
               "Server=" & sServer & ";" & _
               "Uid=;" & _
               "Pwd="

    sServer = "DB2OLEDB"
    cnn(DB2).Open "Provider=MSDASQL.1;Persist Security Info=False;" & _
                "User ID=;" & _
                "Extended Properties=""DSN=Shadow Direct DB2P 32-bit;" & _
                "UID=;PORT=6800;HOST=mvsb1;SUBSYS=DB2P;CPFX=SHADOW;AT=YES;" & _
                "DP=%;AF=YES;MXBU=40960;AUST=NO;CNTM=120;"""


    Set rst(DW_) = New ADODB.Recordset
    Set rst(DB2) = New ADODB.Recordset

    On Error Resume Next
    
    For Each rPN In [Part_Number]
        sSQL(DW_) = "SELECT"
        sSQL(DW_) = sSQL(DW_) & "  PM.NOMEN_201, PM.ITEM_201, PM.GROUP_205, BU.BUYERCD_206, PM.UNITMEAS_201, PM.MINORQTY_205, PM.MAXORQTY_205"
        sSQL(DW_) = sSQL(DW_) & ", Sum(BM.PREPQSHP_133)"
        sSQL(DW_) = sSQL(DW_) & vbCrLf
        sSQL(DW_) = sSQL(DW_) & "FROM"
        sSQL(DW_) = sSQL(DW_) & "  FRH_MRP.PSK02101          PM"
        sSQL(DW_) = sSQL(DW_) & ", FRH_MRP.PSK02306_BUY_DATA BU"
        sSQL(DW_) = sSQL(DW_) & ", FRH_MAPL.PSH01333         BM"
        sSQL(DW_) = sSQL(DW_) & vbCrLf
        sSQL(DW_) = sSQL(DW_) & "WHERE PM.PARTCODE_201    = BU.PARTCODE_201"
        sSQL(DW_) = sSQL(DW_) & "  AND PM.PARTNO_201      = BU.PARTNO_201"
        sSQL(DW_) = sSQL(DW_) & "  AND PM.PARTCODE_201    = BM.COMPCODE_192(+)"
        sSQL(DW_) = sSQL(DW_) & "  AND PM.PARTNO_201      = BM.COMPPART_192(+)"
        sSQL(DW_) = sSQL(DW_) & "  AND PM.PARTNO_201      ='" & rPN.Value & "'"
        sSQL(DW_) = sSQL(DW_) & "  AND BM.PMOD_133(+)     ='101'"
        sSQL(DW_) = sSQL(DW_) & "  AND BM.THRUEFF_133(+)  =999999"
        sSQL(DW_) = sSQL(DW_) & vbCrLf
        sSQL(DW_) = sSQL(DW_) & "Group By"
        sSQL(DW_) = sSQL(DW_) & "  PM.NOMEN_201, PM.ITEM_201, PM.GROUP_205, BU.BUYERCD_206, PM.UNITMEAS_201, PM.MINORQTY_205, PM.MAXORQTY_205"

        Debug.Print sSQL(DW_)

        rst(DW_).Open sSQL(DW_), cnn(DW_), adOpenStatic, adLockReadOnly, adCmdText

        rst(DW_).MoveFirst

        Err.Clear
        
        sSQL(DB2) = "SELECT SV_PART_NUMBER"
        sSQL(DB2) = sSQL(DB2) & vbCrLf
        sSQL(DB2) = sSQL(DB2) & "FROM MATCTL.T_MATLCODE T_MATLCODE_0"
        sSQL(DB2) = sSQL(DB2) & vbCrLf
        sSQL(DB2) = sSQL(DB2) & "WHERE MATLCD='" & rPN.Value & "'"

        Debug.Print sSQL(DB2)

        rst(DB2).Open sSQL(DB2), cnn(DB2), adOpenStatic, adLockReadOnly, adCmdText
                              
        rst(DB2).MoveFirst

        If Err.Number = 0 Then

            wsData.Cells(rPN.Row, 2).Value = rst(DB2).Fields(0).Value

            iCol = 3
            For Each fld In rst(DW_).Fields
                wsData.Cells(rPN.Row, iCol).Value = fld.Value
                iCol = iCol + 1
            Next
        Else
            Err.Clear
        End If

        rst(DW_).Close
        rst(DB2).Close
    Next
    cnn(DW_).Close

    Set rst(DW_) = Nothing
    Set cnn(DW_) = Nothing

    cnn(DB2).Close

    Set rst(DB2) = Nothing
    Set cnn(DB2) = Nothing
End Sub

Skip,
[sub]
Just traded in my old subtlety...
for a brand NUANCE![/sub]