Hello! I'm not sure if this is the correct forum to post this, but here it goes:
I have a database that uses (mainly) two forms: Work Orders, Purchase Orders. I modified their tables, only to reverse all of them, because in testing some new VBA code (After_Update) that updates a record with the user's username and current date, I was getting this error:
You can't save this record at this time.
<Database name> may have encountered an error while trying to save a record. If you close this object now, the data changes you made will be lost. Do you want to close the database object anyway?
I'm unable to go to another record. To be safe, I save the record as a PDF. Open the PDF and those change(s) are there. I click the Yes for the error message. Go back to the record I just changed and the fields show the newest values. I have a mix of macros and VBA. I'm unsure of what else to add here. What is it I'm missing, that I'm getting this error? Thanks for reading and hope to hear from you!
EDIT: I've included a sample copy of the database. There are two users to choose from. 1) Username: Access. Password: 123. 2) Username: Han Solo. Password: Han.
Here's some of the code:
Login form:
Then this is where the GUserName comes from, as a module:
Purchase Order:
Work Order Form:
I have a database that uses (mainly) two forms: Work Orders, Purchase Orders. I modified their tables, only to reverse all of them, because in testing some new VBA code (After_Update) that updates a record with the user's username and current date, I was getting this error:
You can't save this record at this time.
<Database name> may have encountered an error while trying to save a record. If you close this object now, the data changes you made will be lost. Do you want to close the database object anyway?
I'm unable to go to another record. To be safe, I save the record as a PDF. Open the PDF and those change(s) are there. I click the Yes for the error message. Go back to the record I just changed and the fields show the newest values. I have a mix of macros and VBA. I'm unsure of what else to add here. What is it I'm missing, that I'm getting this error? Thanks for reading and hope to hear from you!
EDIT: I've included a sample copy of the database. There are two users to choose from. 1) Username: Access. Password: 123. 2) Username: Han Solo. Password: Han.
Here's some of the code:
Login form:
Code:
' This is theLogin form
Option Compare Database
Private Sub cmd_Cancel_Click()
DoCmd.Quit acQuitSaveAll
End Sub
Private Sub cmd_login_Click()
Dim db As DAO.Database
Dim rst As DAO.Recordset
Dim strSQL As String
If Trim(Me.txt_username.Value & vbNullString) = vbNullString Then
MsgBox prompt:="Username should not be left blank.", buttons:=vbInformation, Title:="Username Required"
Me.txt_username.SetFocus
Exit Sub
End If
If Trim(Me.txt_password.Value & vbNullString) = vbNullString Then
MsgBox prompt:="Password should not be left blank.", buttons:=vbInformation, Title:="Password Required"
Me.txt_password.SetFocus
Exit Sub
End If
'query to check if login details are correct
'updated query to include UserName 10/13/2020
strSQL = "SELECT FirstName, LastName, UserName FROM tbl_login WHERE Username = """ & Me.txt_username.Value & """ AND Password = """ & Me.txt_password.Value & """"
Set db = CurrentDb
Set rst = db.OpenRecordset(strSQL)
If rst.EOF Then
'MsgBox prompt:="Incorrect username/password. Try again.", buttons:=vbCritical, Title:="Login Error" --- commented out 10/13/2020
MsgBox prompt:="Incorrect username/password. Try again.", buttons:=vbCritical, Title:="Login Error" & "strSQL = " & strSQL 'added 10/13/2020
Me.txt_username.SetFocus
Else
'MsgBox prompt:="Hello, " & rst.Fields(0).Value & ".", buttons:=vbOKOnly, Title:="Login Successful" --- commented out 10/13/2020
GUserName = rst.Fields("UserName").Value 'added 10/13/2020
MsgBox prompt:="Hello, " & GUserName & ". .CurrentUser=." & CurrentUser(), buttons:=vbOKOnly, Title:="Login Successful" 'added 10/13/2020
DoCmd.Close acForm, "frm_login", acSaveYes
End If
Set db = Nothing
Set rst = Nothing
DoCmd.OpenForm "Main Menu"
End Sub
Then this is where the GUserName comes from, as a module:
Code:
Option Compare Database
Public GUserName As String
Purchase Order:
Code:
Option Compare Database
Private Sub btnReplicateB_Click()
'On Error GoTo Err_Handler
'Purpose: Duplicate the main form record and related records in the subform.
'Save any edits first
'If Me.Dirty Then
' Me.Dirty = False
'End If
'Make sure there is a record to duplicate.
If Me.NewRecord Then
MsgBox "Select the record to duplicate."
Else
'Duplicate the main record: add to form's clone.
With Me.RecordsetClone
.AddNew
!AccountNumber = Me.AccountNumber
!Client = Me.Client
!CAddress = Me.CAddress
!CCity = Me.CCity
!CState = Me.CState
!CZIP = Me.CZIP
!CContact = Me.CContact
!CPhone = Me.CPhone
!CEmail = Me.CEmail
'etc for other fields.
.Update
End With
End If
End Sub
Private Sub cboAccountNumber_Change()
Me.txtClient.Value = Me.cboAccountNumber.Column(1)
Me.txtCAddress.Value = Me.cboAccountNumber.Column(2)
Me.txtCCity.Value = Me.cboAccountNumber.Column(3)
Me.txtCState.Value = Me.cboAccountNumber.Column(4)
Me.txtCZIP.Value = Me.cboAccountNumber.Column(5)
Me.txtCContact.Value = Me.cboAccountNumber.Column(6)
Me.txtCEmail.Value = Me.cboAccountNumber.Column(7)
Me.txtCPhone.Value = Me.cboAccountNumber.Column(8)
'Me.txtAccountNumber.Value = Me.cboAccountNumber.Column(9)
End Sub
Private Sub cboAccountNumber4_Change()
Me.txtCAddress2.Value = Me.cboAccountNumber4.Column(1)
Me.txtCCity2.Value = Me.cboAccountNumber4.Column(2)
Me.txtCState2.Value = Me.cboAccountNumber4.Column(3)
Me.txtCZIP2.Value = Me.cboAccountNumber4.Column(4)
End Sub
Private Sub cmdReplicate_Click()
Dim AccoutNumber As Long
'TO DO: change all instances of 'BookID' with the actual name of your table's ID or primary key
If IsNull(POrderNumber) Then
MsgBox prompt:="Please select the record to copy first.", buttons:=vbExclamation
Exit Sub
End If
currentID = AccountNumber
DoCmd.GoToRecord record:=acNewRec
'TO DO: set the fields to be copied (those that most likely will have the same values)
'FORMAT: fieldName = Dlookup("fieldname", "tableName", "primaryKeyField=" & currentID)
'FORMAT WHERE CRITERION IS NUMERIC: fieldName = Dlookup("fieldname", "tableName", "primaryKeyField=" & currentID)
'FORMAT WHERE CRITERION IS A STRING: fieldName = Dlookup("fieldname", "tableName", "primaryKeyField='" & currentID & "'")
'FORMAT WHERE CRITERION IS A DATE: fieldName = Dlookup("fieldname", "tableName", "DateField=" & Format(varDate, "\#yyyy\-mm\-dd hh:nn:ss\#"))
'POrderNumber = DLookup("POrderNumber", "PurchaseOrders", "POrderNumber=" & currentID)
AccountNumber = DLookup("AccountNumber", "PurchaseOrders", "POrderNumber='" & currentID & "'")
Client = DLookup("Client", "PurchaseOrders", "POrderNumber='" & currentID & "'")
CAddress = DLookup("CAddress", "PurchaseOrders", "POrderNumber='" & currentID & "'")
CCity = DLookup("CCity", "PurchaseOrders", "POrderNumber='" & currentID & "'")
CState = DLookup("CState", "PurchaseOrders", "POrderNumber='" & currentID & "'")
CZIP = DLookup("CZIP", "PurchaseOrders", "POrderNumber='" & currentID & "'")
CContact = DLookup("CContact", "PurchaseOrders", "POrderNumber='" & currentID & "'")
CPhone = DLookup("CPhone", "PurchaseOrders", "POrderNumber='" & currentID & "'")
CEmail = DLookup("CEmail", "PurchaseOrders", "POrderNumber='" & currentID & "'")
POrderStatus.SetFocus '‘TO DO: change 'Title' with name of field that is going to be edited by the user
End Sub
'Private Sub cmdPDF_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
' MsBox "Save record before exporting it as a PDF"
'End Sub
Private Sub Form_AfterUpdate() 'added 10/13/2020
Me.EditedBy.Value = GUserName
Me.EditDate = Date
End Sub
Work Order Form:
Code:
Private Sub cmdCreateReportForEachRecordAndExport_Click()
Dim sReportName As String
Dim sCriteria As String
sReportName = "WorkOrderRpt" '' name of the predefined report
Dim rs As Recordset2
Set rs = Me.Recordset
rs.MoveFirst
Do While Not rs.EOF
sCriteria = "[WorkOrder#]=" & rs.Fields("WorkOrder#").Value
DoCmd.OpenReport sReportName, acViewNormal, , sCriteria
DoCmd.OutputTo acOutputReport, sReportName, acFormatPDF, "C:\New Folder\" & rs.Fields("WorkOrder#") & ".PDF", False
DoCmd.Close acReport, sReportName
rs.MoveNext
Loop
End Sub
Private Sub btnReplicateC_Click()
'On Error GoTo Err_Handler
'Purpose: Duplicate the main form record and related records in the subform.
'Save any edits first
'If Me.Dirty Then
' Me.Dirty = False
'End If
'Make sure there is a record to duplicate.
If Me.NewRecord Then
MsgBox "Select the record to duplicate."
Else
'Duplicate the main record: add to form's clone.
With Me.RecordsetClone
.AddNew
!AccountNumber = Me.AccountNumber
!Client = Me.Client
!CAddress = Me.CAddress
!CCity = Me.CCity
!CState = Me.CState
!CZIP = Me.CZIP
!CContact = Me.CContact
!CPhone = Me.CPhone
!CEmail = Me.CEmail
!Equipment = Me.Equipment
!MFR = Me.MFR
!Model = Me.Model
!SN = Me.SN
'etc for other fields.
.Update
End With
End If
End Sub
Private Sub cboWOCust_Change()
Me.txtClient.Value = Me.cboWOCust.Column(1)
Me.txtCAddress.Value = Me.cboWOCust.Column(2)
Me.txtCCity.Value = Me.cboWOCust.Column(3)
Me.txtCState.Value = Me.cboWOCust.Column(4)
Me.txtCZIP.Value = Me.cboWOCust.Column(5)
Me.txtCContact.Value = Me.cboWOCust.Column(6)
Me.txtCEmail.Value = Me.cboWOCust.Column(7)
Me.txtCPhone.Value = Me.cboWOCust.Column(8)
End Sub
Private Sub cmdOpenWorkOrders_Click()
Me.Filter = "Status = 'Pending'"
Me.FilterOn = True
End Sub
Private Sub Form_AfterUpdate() 'added 10/13/2020
Me.EditedBy.Value = GUserName
Me.Edited.Value = Date
End Sub
Attachments
Last edited: