Hi i need some help. i am trying to run a process that will move records from one table to the other and i am getting this error msg " Description: Catastrophic failure - Number: -2147418113" in the detailed error log but on the interface m getting something like
Error Occurred in:
frmRT05GMC_DelSel.cmbDelete_Click
Description
Number0
Query SQL: Select SYSTEM_RECORD_NO,GPNational, Pshipcode,GPGMC, Agencycipher From FROM GMS_DYNAMIC_GMS_RT05SEP2009
FileName
See Application error log to view this msg in full
A bit background
I have an access database as the frontend for an Oracle database, if i change the setting to a different month say Mar (March) its working fine but if i change the month to run on Sep (September) data its falling apart: the way i m changing the dates is by ticking and some manually within the code (have double checked this) part of the code thats problematic is as below
Option Compare Database
Option Explicit
Dim msFilter As String
Dim mbFirstTime As Boolean
Private Sub cmbDelete_Click()
On Error GoTo Err_cmbDelete_Click
Dim sql As String
Dim cnt As Long
Dim maxCnt As Long
Dim oLvw As ListView
Dim oLvwItem As ListItem
Set oLvw = Me.lvwSelection.Object
Dim bInTrans As Boolean
Dim iRecAffected As Integer
If oLvw.ListItems.Count = 0 Then
MsgBox "There are no records to delete", vbExclamation, "GMS"
Exit Sub
End If
If MsgBox("Are you sure you want to delete these records", vbQuestion + vbDefaultButton2 + vbYesNo, "GMS") = vbNo Then Exit Sub
DoEvents
For Each oLvwItem In oLvw.ListItems
If oLvwItem.Checked = True Then
maxCnt = maxCnt + 1
End If
Next
Dim oCon As clsOracleCon
Dim rs As ADODB.Recordset
Set oCon = New clsOracleCon
DoCmd.Hourglass True
oCon.conn.Open
For Each oLvwItem In oLvw.ListItems
If oLvwItem.Checked = True Then
sql = "Select System_Record_No,GPNational,PSHIPCODE,GPGMC,AgencyCipher from " & GetTableName("5") & " where System_Record_No=" & oLvwItem
Set rs = oCon.conn.Execute(sql)
If Not rs.EOF Then
'if there is a GP National code then try test for the presence of records in
'rt 07,09 and 12
oCon.conn.BeginTrans
bInTrans = True
If Nz(rs.Fields("GPNational").value, "") <> "" And Nz(rs.Fields("AgencyCipher").value, "") <> "" Then
If Not MoveRT57912ToXX(oCon.conn, "5", "xx5", "System_Record_No", rs.Fields("SYSTEM_RECORD_NO").value, "GPNational", rs.Fields("GPNational").value, rs.Fields("AgencyCipher").value) Then
GoTo Rollback
End If
If rs.Fields("GPNational").value <> 0 Then 'tables linked by GPNational
If Not MoveRT57912ToXX(oCon.conn, "7", "xx7", "GPNational", Nz(rs.Fields("GPNational").value, ""), "PSHIPCODE", rs.Fields("PSHIPCODE").value, rs.Fields("AgencyCipher").value) Then
GoTo Rollback
End If
If Not MoveRT57912ToXX(oCon.conn, "9", "xx9", "GPNational", Nz(rs.Fields("GPNational").value, ""), "PSHIPCODE", rs.Fields("PSHIPCODE").value, rs.Fields("AgencyCipher").value) Then
GoTo Rollback
End If
If Not MoveRT57912ToXX(oCon.conn, "12", "xx12", "GPNational", Nz(rs.Fields("GPNational").value, ""), "PARTNERSHIPCODE", rs.Fields("PSHIPCODE").value, rs.Fields("AgencyCipher").value) Then
GoTo Rollback
End If
End If
End If
'Commit changes
oCon.conn.CommitTrans
bInTrans = False
cnt = cnt + 1
End If
Set rs = Nothing
If cnt Mod 10 = 0 Then
Me.lblStatus.Caption = "Moved " & cnt & " of " & maxCnt & " to the XX tables. Please wait"
DoEvents
End If
End If
Next
Me.lblStatus.Caption = "Moved " & cnt & " of " & maxCnt & " to the XX tables"
DoEvents
cmbLoad_Click
Exit_cmbDelete_Click:
DoCmd.Hourglass False
If Not oCon Is Nothing Then
oCon.KillConn
Set oCon = Nothing
End If
Exit Sub
Err_cmbDelete_Click:
If bInTrans = True Then
oCon.conn.RollbackTrans
bInTrans = False
End If
DoCmd.Hourglass False
Errortrap True, err, Me.Name, "cmbDelete_Click", "", sql
Resume 'Exit_cmbDelete_Click
Rollback:
If bInTrans Then
oCon.conn.RollbackTrans
DoCmd.Hourglass False
MsgBox "There was an error and some records were not moved to the xx tables. See application log", vbCritical, "GMS"
GoTo Exit_cmbDelete_Click
End If
End Sub
Private Sub cmbLoad_Click()
On Error GoTo Err_cmbLoad_Click
Dim sql As String
Dim sFilter As String
If msFilter <> "" Then
sFilter = "AND MA.AgencyCipher in (" & msFilter & ") "
Else
sFilter = ""
End If
Me.lblStatus.Caption = "."
Dim sChecked As String
Dim sSetting As String
sSetting = "Checkbox settings " & Me.Name
If Not mbFirstTime Then
'remember checked boxes
sChecked = GetCheckedBoxList(Me.lvwSelection.Object)
modSettings.SetSettingLocal sSetting, sChecked, "Form Setting", True
Else
mbFirstTime = False
sChecked = modSettings.GetSettingLocal(sSetting, "")
End If
sql = "SELECT A.System_Record_No AS ID,A.AgencyCipher, A.GPGMC,A.GPNational," & _
" A.GPSURNAME , " & _
"A.GPINITIALS , " & _
"A.GPSEX,A.GPCATEGORYSTAT , " & _
"A.PSHIPCODE, A.PCGPCTNATIONALCODE " & _
"FROM " & GetTableName("5") & " A " & _
"LEFT JOIN " & GetTableName("EMPFILE") & " E ON A.GPGMC = E.GMC_NUMBER " & _
" WHERE E.GMC_Number is null " & sFilter
Dim oCon As clsOracleCon
Dim rs As ADODB.Recordset
Set oCon = New clsOracleCon
DoCmd.Hourglass True
oCon.conn.Open
Set rs = oCon.conn.Execute(sql)
PopulateListViewADO rs, Me.lvwSelection.Object
SetCheckedBoxList Me.lvwSelection.Object, sChecked
Exit_cmbLoad_Click:
DoCmd.Hourglass False
If Not oCon Is Nothing Then
oCon.KillConn
Set oCon = Nothing
End If
Exit Sub
Err_cmbLoad_Click:
DoCmd.Hourglass False
Errortrap True, err, Me.Name, "cmbLoad_Click", "", sql
Resume Exit_cmbLoad_Click
End Sub
Private Sub cmbSelectAll_Click()
Dim oLvw As MSComctlLib.ListView
Set oLvw = Me.lvwSelection.Object
Dim oLvwItem As MSComctlLib.ListItem
If oLvw.ListItems.Count = 0 Then
Exit Sub
End If
For Each oLvwItem In oLvw.ListItems
If Me.cmbSelectAll.Caption = "De-Select All" Then
oLvwItem.Checked = False
Else
oLvwItem.Checked = True
End If
Next
If Me.cmbSelectAll.Caption = "De-Select All" Then
Me.cmbSelectAll.Caption = "Select All"
Else
Me.cmbSelectAll.Caption = "De-Select All"
End If
Set oLvw = Nothing
End Sub
Private Sub cmbSelectStatus7810_Click()
Dim oLvw As MSComctlLib.ListView
Set oLvw = Me.lvwSelection.Object
Dim oLvwItem As MSComctlLib.ListItem
If oLvw.ListItems.Count = 0 Then
Exit Sub
End If
For Each oLvwItem In oLvw.ListItems
If oLvwItem.SubItems(7) = 7 Or oLvwItem.SubItems(7) = 8 Or oLvwItem.SubItems(7) = 10 Then
oLvwItem.Checked = True
Else
oLvwItem.Checked = False
End If
Next
Set oLvw = Nothing
End Sub
Private Sub Form_Close()
Dim sChecked As String
Dim sSetting As String
sSetting = "Checkbox settings " & Me.Name
sChecked = GetCheckedBoxList(Me.lvwSelection.Object)
modSettings.SetSettingLocal sSetting, sChecked, "Form Setting", True
End Sub
Private Sub Form_Load()
DoCmd.Maximize
mbFirstTime = True
cmbLoad_Click
End Sub
Private Sub Form_Open(Cancel As Integer)
msFilter = Me.OpenArgs
ClearListview Me.lvwSelection.Object
If msFilter <> "" Then
Else
MsgBox "Please re-open this form to re-set the filter", vbExclamation, "GMS"
Cancel = True
Exit Sub
End If
End Sub
Private Sub lvwSelection_ColumnClick(ByVal ColumnHeader As Object)
Dim oListView As ListView
Dim oColumn As ColumnHeader
Dim oColumnSort As ColumnHeader
If ShowListOptionDialog(Me.lvwSelection.Object, ColumnHeader) = "reorder" Then
Set oListView = Me.lvwSelection.Object
For Each oColumn In oListView.ColumnHeaders
If oColumn.Key = ColumnHeader.Key & "SORT" Then
Set oColumnSort = oColumn
Exit For
End If
Next oColumn
If oColumnSort Is Nothing Then
Set oColumnSort = ColumnHeader
End If
If oListView.SortKey = oColumnSort.Index - 1 Then
oListView.Sorted = True
If oListView.SortOrder = lvwAscending Then
oListView.SortOrder = lvwDescending
Else
oListView.SortOrder = lvwAscending
End If
Else
oListView.Sorted = True
oListView.SortKey = oColumnSort.Index - 1
oListView.SortOrder = lvwAscending
End If
End If
Set oListView = Nothing
Set oColumn = Nothing
Set oColumnSort = Nothing
End Sub
Private Sub cmbUnselectAll_Click()
On Error GoTo Err_cmbUnselectAll_Click
Screen.PreviousControl.SetFocus
DoCmd.FindNext
Exit_cmbUnselectAll_Click:
Exit Sub
Err_cmbUnselectAll_Click:
MsgBox err.Description
Resume Exit_cmbUnselectAll_Click
End Sub