Using Access w/Oracle to update Access Linked table

[kfschaefer]

Looking for the best approach to updating/altering an Access table via DSN-less connection string.

Situation: This process will be run nightly via MS Schedule tool

Database 1 - contains 1 table which acts as a linked central datasource for numerous databases - this cannot be change. - in some instances this maybe left active which affects the altering of the table. Alter is need to change 3 fields's data types or convert prior to update.

Database 2 - contains the temporary table and the code or possibly just the code to update the data in the linked table source.

Note this code cannot be kept in DATABASE1 - due to the fact that this database is occasionally opened and used by other users, so I cannot have the Autoexec fired when the user access the database - hence the need for Database2.

Now the Oracle data source contains numerous fields that need to be converted in 1 way or another, including converting a date that in contains a text (varchar) datatype ie. 090822, when I attempt to covert this and place in an Access Date/Time field - I am getting an error.

My thought is to create the temp table then export into Database 1 - which will replace the existing with the new data - or possibly have the Database2-tbl linked in Database1 and do a delete and append queries - however, then I run into the conversion issue.

Any and all suggestions is greatly appreciated.

Note the date field = SERVICE_DUE_DATE_CMT, LAST_SERVICE_DATE, PURCHASE_DATE that needs the conversion within the code or using the alter tables

Thanks,

Karen

Here is my existing code.



Public Function FTCSConnection()
Dim sConn As String
Dim oConn As ADODB.Connection
Dim rstOra As ADODB.Recordset, rs As ADODB.Recordset
Dim adoRS As ADODB.Recordset
Dim cn As ADODB.Connection
Dim ctl As Control
Dim j, I As Long
Dim rsField, tblField As String
Dim rsValue, tblValue As String
Dim varNM As Variant ' Nomenclature_Modifier
Dim varLSD As Variant ' Last Service Date
Dim varRNG As Variant ' Range
Dim varSDD As Variant ' Service Due Date Cmt
Dim varEQL As Variant ' Equipment Location
Dim varPAmt As Variant ' PURCHASE_AMT
Dim varPDate As Variant ' PURCHASE_DATE
On Error GoTo FTCSConnection_Error

DoCmd.SetWarnings False

Set cn = CurrentProject.Connection

sConn = _
"Provider=OraOLEDB.Oracle;Data Source=(DESCRIPTION=(ADDRESS_LIST=(ADDRESS=(PROTOCOL=TCP)" & _
"(Host=Server1.com)(Port=1521)))(CONNECT_DATA=(SID=serv1)));" & _
"User Id=*****;Password=******"
Set adoConn = New ADODB.Connection
adoConn.Open sConn
Set adoRS = New ADODB.Recordset
STRSQL = "Alter Table [TL_FTEM_TEMP] alter column SERVICE_DUE_DATE_CMT varchar"
CurrentProject.Connection.Execute STRSQL
STRSQL = "Alter Table [TL_FTEM_TEMP] alter column LAST_SERVICE_DATE varchar"
CurrentProject.Connection.Execute STRSQL
STRSQL = "Delete * from TL_FTEM_TEMP"
CurrentProject.Connection.Execute STRSQL
Set rs = New ADODB.Recordset
STRSQL = "Select * from TL_FTEM_TEMP"
rs.Open STRSQL, cn, adOpenDynamic, adLockOptimistic

STRSQL = " SELECT DISTINCT A.FTEM_ID AS FirstofEquipment_ID, A.EQPT_NAME AS NOMENCLATURE, A.NOMEN_MODIFIER_NAME AS Nomenclature_Modifier," & _
" A.EQPT_LOC_NO, A.SERVICE_ORGN_CODE,COUNT(*) AS CountOfEQUIPMENT_ID," & _
" A.SERVICE_DUE_DATE_CMT, A.LAST_SERVICE_DATE, A.MFR_NAME AS Manufacturer, A.MFR_NO AS Model, A.PART_VENDOR_SERIAL_NO AS VendorPart, A.RANGE," & _
" EM.PURCHASE_AMT, EM.PURCHASE_DATE" & _
" FROM Server1.FTEM_VI_VW AS A INNER JOIN Server1.EQUIPMENT_MANAGEMENT AS EM ON A.FTEM_ID = EM.FTEM_ID" & _
" GROUP BY A.FTEM_ID, A.EQPT_NAME, A.NOMEN_MODIFIER_NAME, A.EQPT_LOC_NO, A.SERVICE_ORGN_CODE," & _
" A.Service_Due_Date_CMT," & _
" A.LAST_SERVICE_DATE, A.MFR_NAME, A.MFR_NO, A.PART_VENDOR_SERIAL_NO, A.RANGE," & _
" EM.PURCHASE_AMT, EM.PURCHASE_DATE" & _
" HAVING (((A.SERVICE_ORGN_CODE) Is Not Null))" & _
" ORDER BY A.FTEM_ID;"
Debug.Print STRSQL
Set adoRS = New ADODB.Recordset
adoRS.Open STRSQL, adoConn, adOpenDynamic, adLockReadOnly
adoRS.MoveFirst
Do Until adoRS.EOF
If Not IsNull(adoRS("Nomenclature_Modifier")) And adoRS("Nomenclature_Modifier") <> "" Then
varNM = Replace(adoRS("Nomenclature_Modifier"), Chr(34), Chr(34) & Chr(34)) 'double up double quotes
varNM = Replace(adoRS("Nomenclature_Modifier"), "'", "''") 'double up single quotes
End If
If Not IsNull(adoRS("EQPT_LOC_NO")) And adoRS("EQPT_LOC_NO") <> "" Then
varEQL = Replace(adoRS("EQPT_LOC_NO"), Chr(34), Chr(34) & Chr(34)) 'double up double quotes
varEQL = Replace(adoRS("EQPT_LOC_NO"), "'", "''") 'double up single quotes
End If
If Not IsNull(adoRS("SERVICE_DUE_DATE_CMT")) And adoRS("SERVICE_DUE_DATE_CMT") <> "" Then
varSDD = Format(DateSerial(Left(adoRS("SERVICE_DUE_DATE_CMT"), 2), Mid(adoRS("SERVICE_DUE_DATE_CMT"), 3, 2), Right(adoRS("SERVICE_DUE_DATE_CMT"), 2)), "Short Date")
Else
varSDD = adoRS("SERVICE_DUE_DATE_CMT")
End If
Debug.Print varSDD
If Not IsNull(adoRS("LAST_SERVICE_DATE")) And adoRS("LAST_SERVICE_DATE") <> "" Then
varLSD = Format(CDate(adoRS("LAST_SERVICE_DATE")), "Short Date")
Else
varLSD = adoRS("LAST_SERVICE_DATE")
End If
If Nz(adoRS("Range"), "") <> "" Then
varRNG = Replace(adoRS("Range"), Chr(34), Chr(34) & Chr(34)) 'double up double quotes
varRNG = Replace(adoRS("Range"), "'", "''") 'double up single quotes
varRNG = LTrim(varRNG)
End If
If Not IsNull(adoRS("PURCHASE_AMT")) And adoRS("PURCHASE_AMT") <> "" Then
varPAmt = Replace(adoRS("PURCHASE_AMT"), Chr(34), Chr(34) & Chr(34)) 'double up double quotes
varPAmt = Replace(adoRS("PURCHASE_AMT"), "'", "''") 'double up single quotes
End If
If Not IsNull(adoRS("PURCHASE_DATE")) And adoRS("PURCHASE_DATE") <> "" Then
varPDate = Format(CDate(adoRS("PURCHASE_DATE")), "Short Date")
Else
varPDate = adoRS("PURCHASE_DATE")
End If
STRSQL = "INSERT INTO TL_FTEM_Temp (FirstofEquipment_ID, NOMENCLATURE, Nomenclature_Modifier, "
STRSQL = STRSQL & "EQPT_LOC_NO, SERVICE_ORGN_CODE, CountOfEQUIPMENT_ID, "
STRSQL = STRSQL & "SERVICE_DUE_DATE_CMT, LAST_SERVICE_DATE, Manufacturer, Model, "
STRSQL = STRSQL & "VendorPart, RANGE, PURCHASE_AMT, PURCHASE_DATE" & _
STRSQL = STRSQL & "VALUES('"
STRSQL = STRSQL & Nz(adoRS("FirstofEquipment_ID"), "") & "', '" & Nz(adoRS("NOMENCLATURE"), "") & "', '"
STRSQL = STRSQL & varNM & "', '" & varEQL & "', '"
STRSQL = STRSQL & Nz(adoRS("SERVICE_ORGN_CODE"), "") & "', '" & Nz(adoRS("CountOfEQUIPMENT_ID"), "") & "', '"
STRSQL = STRSQL & varSDD & "', '" & varLSD & "', '" & Nz(adoRS("Manufacturer"), "") & "', '"
STRSQL = STRSQL & Nz(adoRS("Model"), "") & "', '" & Nz(adoRS("VendorPart"), "") & "', '" & varRNG & "')"
STRSQL = STRSQL & Nz(adoRS("PURCHASE_AMT"), "") & "', '" & Nz(adoRS("PURCHASE_AMT"), "") & "', '" & varPAmt & "')"
STRSQL = STRSQL & Nz(adoRS("PURCHASE_DATE"), "") & "', '" & Nz(adoRS("PURCHASE_DATE"), "") & "', '" & varPDate & "')"

DoEvents
CurrentProject.Connection.Execute STRSQL, dbFailOnError
adoRS.MoveNext
Loop
rs.Close
Set rs = Nothing
adoRS.Close
Set adoRS = Nothing

STRSQL = "Alter Table [TL_FTEM_TEMP] alter column SERVICE_DUE_DATE_CMT Date"
CurrentProject.Connection.Execute STRSQL
STRSQL = "Alter Table [TL_FTEM_TEMP] alter column LAST_SERVICE_DATE Date"
CurrentProject.Connection.Execute STRSQL
STRSQL = "Alter Table [TL_FTEM_TEMP] alter column PURCHASE_DATE Date"
CurrentProject.Connection.Execute STRSQL
DoCmd.Close acTable, "TL_FTEM_TEMP", acSaveYes
On Error GoTo 0
Exit Function

FTCSConnection_Error:

MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure FTCSConnection of Module Functions"

End Function