Option Compare Database
Option Explicit
Public Const db_name As String = "TEST"
Public Const jup As String = "TEST"
Public Const pwd As String = "TEST"
Public Const uid As String = "TEST"
Public Const dbq As String = "TEST"
Public Const dsn_main As String = "{Oracle in DEFAULT_HOME}"
Public Const dsn_alt As String = "(Oracle in ORACLE_HOME)"
Dim dsn_use As String
Private Function Get_Local_Number(tbl As String) As Long
'Establish number of records in tbl
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Set dbs = CurrentDb
Set rst = dbs.OpenRecordset(tbl, dbOpenTable)
Get_Local_Number = rst.RecordCount
rst.close
dbs.close
Set rst = Nothing
Set dbs = Nothing
Get_Local_Number_Exit:
Exit Function
Get_Local_Number_Err:
Select Case Err.Number
Case Else
DoCmd.SetWarnings True
MsgBox Err.Number & Chr(13) & Chr(10) & Err.Description
End Select
Resume Get_Local_Number_Exit
End Function
Private Sub Get_ODBC_Number(tbl As String, _
drv As Integer, _
num As Long, _
con As String)
On Error GoTo Get_ODBC_Number_Err
'Establish number of records in Oracle tbl via ODBC.
Dim wrkODBC As Workspace
Dim conODBC As Connection
Dim rstODBC As Recordset
dsn_use = dsn_main
Set wrkODBC = CreateWorkspace("ODBCWorkspace", _
uid, _
pwd, _
dbUseODBC)
Set conODBC = wrkODBC.OpenConnection("Connection1", drv, , _
"ODBC;DRIVER=" & dsn_use & ";DBQ=" & dbq & ";UID=" & uid & _
";PWD=" & pwd & ";DSN=" & dsn_use & ";")
Set rstODBC = conODBC.OpenRecordset(tbl, dbOpenDynamic)
con = conODBC.Connect
num = rstODBC.RecordCount
rstODBC.close
wrkODBC.Connections(0).close
wrkODBC.close
Set rstODBC = Nothing
Set conODBC = Nothing
Set wrkODBC = Nothing
Get_ODBC_Number_Exit:
Exit Sub
Get_ODBC_Number_Err:
Select Case Err.Number
Case 3146
num = -1
If dsn_use = dsn_main Then
dsn_use = dsn_alt
End If
Resume 0
DoCmd.SetWarnings True
Case Else
num = -1
DoCmd.SetWarnings True
MsgBox Err.Number & Chr(13) & Chr(10) & Err.Description, , db_name
End Select
Resume Get_ODBC_Number_Exit
End Sub
Sub Download(qryName1 As String, qryName2 As String, sysName As String)
On Error GoTo Download_Err
Dim odbc_num As Long
Dim odbc_con As String
DoCmd.SetWarnings False
Get_ODBC_Number "UOP_ASK_DATA_MVW", dbDriverNoPrompt, odbc_num, odbc_con
If odbc_num < 0 Then
Err.Raise vbObjectError + 513
End If
SysCmd acSysCmdSetStatus, "Searching for " & sysName & " data"
RunQueryDown qryName1, qryName2, odbc_con
Download_Exit:
DoCmd.SetWarnings True
Exit Sub
Download_Err:
Select Case Err.Number
Case 3146
If InStr(1, Error(Err.Number), "ORA-00942") > 0 Then
Resume Next
ElseIf InStr(1, Error(Err.Number), "ORA-00955") > 0 Then
Resume Next
End If
Case vbObjectError + 513
MsgBox "Invalid connection details. Download aborted.", _
vbOKOnly, _
db_name
Resume Download_Exit
Case Else
MsgBox Error$ & Chr(13) & Chr(10) & Err.Number, , db_name
Resume Download_Exit
End Select
End Sub
Private Sub RunQueryDown(qryName1 As String, _
qryName2 As String, _
qryCon As String)
Dim dbs As DAO.Database
Set dbs = CurrentDb
With dbs
.QueryDefs(qryName1).Connect = qryCon
.QueryDefs.Refresh
.QueryDefs(qryName1).close
DoCmd.OpenQuery qryName2, acViewNormal
.QueryDefs(qryName1).Connect = "ODBC;"
.QueryDefs.Refresh
.QueryDefs(qryName1).close
.close
End With
Set dbs = Nothing
End Sub
