Sub ADO_Update_Oracle(sTblNameLOAD_TO As String, sTblNameEXTRACT_FROM As String)
On Error GoTo ERR_HANDLER
Dim oconn As New ADODB.Connection
Dim ADOrst As ADODB.Recordset
Dim rst As DAO.Recordset
Dim db As Database
Dim i As Integer
Dim sEXTRACT_SQL As String
Dim lEXTRACT_SQL_COUNT As Long
Dim sSQL_Value As String
Dim sSQL As String
Dim ssqlFields As String
Dim sFULL_SQL As String
Dim x As Long
Set db = CurrentDb()
Debug.Print "time started " & Now()
'--- Create extract SQL statement
sEXTRACT_SQL = "select * from " & sTblNameEXTRACT_FROM
'--- Set the recordset that we are extracting from
Set rst = db.OpenRecordset(sEXTRACT_SQL, dbOpenDynaset)
'--- Create connection to Oracle
With oconn
.ConnectionString = "Driver={Oracle ODBC Driver};" & _
"Dbq=FDMU;" & _
"Uid=FDM;" & _
"Pwd=NOTFDM"
.Open
.CursorLocation = adUseServer
End With
'--- Initialise x, this is just used to update a progress in the debug window.
x = 0
'--- Get a record count of the extract SQL
With rst
.MoveLast
lEXTRACT_SQL_COUNT = .RecordCount
.MoveFirst
End With
'--- Get the fields from extracting table now so we only have to do it once
For i = 0 To rst.Fields.Count - 1
ssqlFields = ssqlFields & ", " & rst.Fields(i).Name
Next
' --- Trim the leading ","
ssqlFields = StrConv(Right(ssqlFields, Len(ssqlFields) - 1), vbUpperCase)
Debug.Print ssqlFields
'--- Lets create the SQL statment to insert and insert it!
Do While Not (rst.BOF Or rst.EOF)
'--- create a string to insert
For i = 0 To rst.Fields.Count - 1
sSQL_Value = createCorrectValue(Nz(rst.Fields(i).Value, ""), rst.Fields(i).Type)
sSQL = sSQL & ", " & sSQL_Value
Next
'--- Trim the leading "," from the SQL
sSQL = Right(sSQL, Len(sSQL) - 1)
'--- Create the actual SQL insert statement
sFULL_SQL = "INSERT INTO " & sTblNameLOAD_TO & " (" & ssqlFields & ")" & "VALUES (" & sSQL & ")"
'Debug.Print sFULL_SQL
'--- Load the insert statement into Oracle
oconn.Execute sFULL_SQL
'--- Initialise sSQL
sSQL = ""
'--- move on to the next one
rst.MoveNext
'Stop
x = x + 1
If x Mod 1000 = 0 Then
Debug.Print x / lEXTRACT_SQL_COUNT * 100 & ", " & Now()
End If
Loop
NORMAL_EXIT:
oconn.Close
Set oconn = Nothing
Set ADOrst = Nothing
Exit Sub
ERR_HANDLER:
MsgBox Err.Number & ", " & Err.Description
MsgBox "line " & x & "has an error in it"
Debug.Print sFULL_SQL
Resume Next
End Sub
Function createCorrectValue(sValue As String, iFieldType As Integer) As String
Dim iPos As Integer
Dim x As Integer
'--- Initialise
x = 1
'--- we want to quote text strings with single quotes
Select Case iFieldType
Case dbText
'--- Oracle uses single quotes, so we need to remove them as they will create an incorrect string to be returned
If InStr(sValue, "'") > 0 Then
'--- There may be more than one instance of the dreaded single quote in the string
Do Until x = Len(sValue)
iPos = InStr(x, sValue, "'")
If iPos <> 0 Then
x = iPos
'--- I'm just being lazy
)
sValue = Left(sValue, x - 1) & Trim(Mid(sValue, x + 1, 255))
End If
x = x + 1
Loop
End If
createCorrectValue = Chr(39) & sValue & Chr(39)
Case dbDate
createCorrectValue = Chr(39) & Format(sValue, "dd mmm yyyy") & Chr(39)
Case Else
'--- we have already converted nulls to "" so if it isn't a text it'll get changed to a 0
If sValue = "" Then
createCorrectValue = 0
Else
createCorrectValue = Nz(sValue, "''")
End If
End Select
End Function
