1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168
|
Option Compare Database
Option Base 1
Option Explicit
Public Enum TblAlias
NumMail = 1
Apriori = 2
Archives = 3
Batches = 4
Budget = 5
PanelDec = 6
HoProd = 7
Partners = 8
AddrPart = 9
ProdBatch = 10
PhaseI = 11
ProdRoles = 12
Products = 13
TRdocMM = 14
sysRights = 15
End Enum
Public Enum OraAction
UpdateValues = 1
AddValues = 2
AddIds = 3
DeleteIds = 4
end Enum
Private Const OracleProvider = "Provider=OraOLEDB.Oracle;" & _
"User ID=xxx;" & _
"Password=xxxx;" & _
"Persist Security Info=false;" & _
"Data source=xxx;"
Private ConOpen As Boolean
Private FindOk As Boolean
Private HaveIdx As Boolean
Private conOra As New ADODB.Connection
Private rstOra As New ADODB.Recordset
Private TABLE As New cTables
Sub OraUpdateValues(Action as OraAction, nTable As TblAlias, iPrim As Variant, Optional iSec As Variant = Null, _
Optional nFields As String = Null, Optional Values As Variant = Null, _
Optional withCheck As Boolean = False) 'witchCheck : si besoin de vérifier si Id exit avant d'ajouter)
On Error GoTo Err_Hand
TABLE.InitValues nTable, nFields, Values, iPrim, iSec
Select Case Action
Case 1
If OraInit and FindRecord Then UpdateValue
Case 2
If OraInit and Not (FindRecord And withCheck) Then 'Seulemt si les 2 condition sont vrai rien faire
AddRecord
UpdateValue
End If
Case 3
If OraInit and Not (FindRecord And withCheck) Then AddRecord 'Seulemt si les 2 condition sont vrai rien faire
Case 4
If OraInit And FindRecord Then
rstOra.Delete
rstOra.Update
End If
End Select
If ConOpen Then CloseTable
Exit Sub
Err_Hand:
ErrorClose Err.Description
End Sub
'***********************
Function OraInit() As Boolean
OraInit = False
ConOpen = False
On Error GoTo Err_Hand
conOra.Open OracleProvider
rstOra.CursorLocation = adUseServer
rstOra.Open TABLE.Name, conOra, adOpenKeyset, adLockOptimistic, adCmdTableDirect
If rstOra.Supports(adIndex) And rstOra.Supports(adSeek) Then
rstOra.Index = "PrimaryKey"
HaveIdx = True
End If
If Not rstOra.EOF Then
ConOpen = True
OraInit = True
End If
Exit Function
Err_Hand:
ErrorClose Err.Description
End Function
'***********************
Private Sub AddRecord(Scope As Byte)
On Error GoTo Err_Hand
If ConOpen Then
rstOra.AddNew
rstOra.Fields(TABLE.KeyName(1)) = TABLE.KeyValue(1)
If TABLE.KeyCount = 2 Then rstOra.Fields(TABLE.KeyName(2)) = TABLE.KeyValue(2)
' Temporairement il faut gérer l'erreur "ORA-01410: invalid ROWID" pour les tables que sont en "Index-organized" /// à vérifier plutard
On Error Resume Next
rstOra.Update
If Err.Number = -2147467259 Then Resume Next Else GoTo Err_Hand
On Error GoTo Err_Hand
rstOra.Resync
End If
Exit Sub
Err_Hand:
ErrorClose Err.Description
End Sub
Private Function FindRecord(Scope As Byte) As Long
On Error GoTo Err_Hand
FindRecord = False
If ConOpen Then
rstOra.MoveFirst
Select Case TABLE.KeyCount
Case 1
If HaveIdx Then
rstOra.Seek Array(TABLE.KeyValue(1)), adSeekFirstEQ
Else
rstOra.Find TABLE.KeyName(1) & " = " & TABLE.KeyValue(1), , adSearchForward, 1
End If
Case 2
If HaveIdx Then
rstOra.Seek Array(TABLE.KeyValue(1), TABLE.KeyValue(2)), adSeekFirstEQ
Else
' not working : rstOra.Find TABLE.KeyName(1) & "=" & TABLE.KeyValue( 1) & " AND " & TABLE.KeyName(2) & "=" & TABLE.KeyValue( 2) Temporaire (c'est pas propre, pas le temps de m'acharner)
Do While Not rstOra.EOF
If rstOra.Fields(TABLE.KeyName(1)).Value = TABLE.KeyValue(1) And _
rstOra.Fields(TABLE.KeyName(2)).Value = TABLE.KeyValue(2) Then
Exit Do
End If
rstOra.MoveNext
Loop
End If
End Select
If Not rstOra.EOF Then FindRecord = True
End If
Exit Function
Err_Hand:
ErrorClose Err.Description
End Function
Private Sub UpdateValue
On Error GoTo Err_Hand
If ConOpen Then
rstOra.Fields(TABLE.Champs(1)) = TABLE.Champs(2)
rstOra.Update
rstOra.Resync
End If
Exit Sub
Err_Hand:
ErrorClose Err.Description
End Sub
Private Sub CloseTable(Optional Value As Byte = 0)
If Value = 0 Then
If rstOra.State = adStateOpen Then rstOra.Close
End If
Set rstOra = Nothing
If Not conOra Is Nothing Then
If conOra.State = adStateOpen Then conOra.Close
End If
Set conOra = Nothing
ConOpen = False
DoCmd.Hourglass False
End Sub
Private Sub ErrorClose(errDesc As String)
MsgBox "A error occure: " & vbCrLf & "'" & errDesc & "'" & vbCrLf & "Please contact the IT Support", _
vbCritical + vbOKOnly, "Workflow Manager"
Err.Clear
CloseTable 1
End Sub |
Partager