Dear Friends,
I have code working fine for last one year, suddenly it stopped working without any reason. hitting my head on the wall, appreciate your help.
I wonder how it stopped working without doing any thing.
stopping the process on 'rs.Update' Getting error message 'Run time error -2147467259(80004005) Query " is corrupt, when I add 'on error resume next' getting error 'Run-time error 3219-Operation is not allowed in this context'.
VBA Reference attached here with.
Appreciate any help on this
thanks
Robin
I have code working fine for last one year, suddenly it stopped working without any reason. hitting my head on the wall, appreciate your help.
I wonder how it stopped working without doing any thing.
Code:
Dim vrange As Variant
Dim cnn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim strSQL As String
Dim appPath As String
Dim dbName As String
Dim cntr As Long, xPosition As Long
Public Function username()
username = Environ$("UserName")
End Function
Public Function User()
User = Application.username
End Function
Sub openDB()
'dbName = Sheets("Home").Range("z1").Value
If cnn.State = adStateOpen Then cnn.Close
'C:\Users\veekay\Desktop\Excel Userform Application\Database12003Format.mdb
cnn.ConnectionString = "Provider=Microsoft.ACE.OLEDB.16.0;Data Source= \\ho-webstore\ncr\ServiceDue\ServiceDue.accdb;Jet OLEDB:Database Password=secreT;Persist Security Info=False"
'cnn.ConnectionString = "Provider=Microsoft.ACE.OLEDB.16.0;Data Source= \\ho-webstore\atm\ATM_REFUND_PROCESS\refund_database.accdb;Persist Security Info=False"
cnn.CommandTimeout = 600
cnn.Open
End Sub
Sub closeRS()
If rs.State = adStateOpen Then rs.Close
rs.CursorLocation = adUseClient
End Sub
Private Sub CommandButton1_Click()
'On Error GoTo Epopup:
If Unique.Value = "" Then
MsgBox "Please select a RegNo to update", vbOKOnly
Unique.SetFocus
Exit Sub
End If
If VCollected.Value = "" Then
MsgBox "Vehicle collected status should be yes or no", vbOKOnly
VCollected.SetFocus
Exit Sub
End If
strSQL = "SELECT Master.* FROM Master WHERE (((Master.[ID])=" & Me.Unique & "));"
closeRS
openDB
rs.Open strSQL, cnn, adOpenKeyset, adLockOptimistic
If rs.RecordCount > 0 Then
With rs
'On Error Resume Next
.Fields("AssignedTo").Value = AssignTo
.Fields("BookingDate").Value = BookingDate
.Fields("Remarks").Value = Remarks
.Fields("VehicleCollected").Value = VCollected
rs.Update
' On Error GoTo 0
End With
rs.Close
cnn.Close
Set rs = Nothing
Set cnn = Nothing
MsgBox "Saved Successfully.", vbOKOnly
AssignTo.Value = ""
BookingDate.Value = ""
Remarks.Value = ""
VCollected.Value = ""
Exit Sub
End If
Epopup:
MsgBox "Connection lost, try again later time", vbOKOnly
Exit Sub
End Sub
stopping the process on 'rs.Update' Getting error message 'Run time error -2147467259(80004005) Query " is corrupt, when I add 'on error resume next' getting error 'Run-time error 3219-Operation is not allowed in this context'.
VBA Reference attached here with.
Appreciate any help on this
thanks
Robin
Attachments
Last edited by a moderator: