I have my code below in order to see if a user creates a 4 digit pin, if they don't fill a pin then the pin will be set up as and empty string. No big deal.
I am testing this in the if statement below, but it is returning an invalid use of null exception:
Dim U As String
If Me.txtUnlock = Null Then
U = 0
Else
U = Me.txtUnlock
End If
If IsNumeric(U) = False Then
MsgBox "Unlock pin only accepts numbers only.", , "Retail unlock"
Me.txtUnlock = Null
Me.txtUnlock.SetFocus
Exit Sub
End If
If Len(U) <> 4 Then
MsgBox "Retail unlock must be four digits long.", , "Retail unlock"
Me.txtUnlock.SetFocus
Exit Sub
End If
Then I check if the pin is empty below:
If IsNull(Me.txtUnlock) Then
check = check + 1
UL = ""
Else
UL = Me.txtUnlock
End If
If Me.txtUnlock = Null Then
That you can't do. Try with:
If IsNull(Me!txtUnlock.Value) Then
Consider this streamlined code using NZ function:
Dim U As String
U = NZ(Me.txtUnlock,0)
Dim fail as Boolean
If Not IsNumeric(U) Then
MsgBox "Unlock pin only accepts numbers only.", , "Retail unlock"
fail = true
ElseIf Len(U) <> 4 Then
MsgBox "Retail unlock must be four digits long.", , "Retail unlock"
fail = true
End If
If fail then
With Me.txtUnlock
.value = vbNullString
.SetFocus
End With
End If
Related
I connected the MS Access - Frontend with MySQL database using ODBC Connector.
There I have the tblCustomer and tblPayments. tblCustomer is linked with the tblPayments with the foreign key.
I had written the code to update the payment details of the respective customer.
For that, we have to update the existing recordset of the tblCustomer with the new payment entries.
Basically, Existing customers' payment information can be changed. In tblCustomer we have to Update the new payment details.
Suppose the old balance is $10. Now the person has paid the $10. So the current balance will be $0.
When I try to edit and update the new $0 balance to the tblCustomer it shows me
ODBC - inserting failed.
On Error GoTo Proc_Err
' variable for return from msgbox
Dim intRetValue As Integer
If Me.PaymentAmount = 0 Then
MsgBox "You must enter a payment amount or cancel the transaction.", vbOKOnly
Exit Sub
End If
If Me.txtPaymentVoucher < 1 Or IsNull(Me.txtPaymentVoucher) Then
MsgBox "You must enter a voucher number.", vbOKOnly
Me.txtPaymentVoucher.SetFocus
Exit Sub
End If
If Me.TransactionType = "Debit" Then
If Me.PaymentAmount > 0 Then
Me.PaymentAmount = Me.PaymentAmount * -1
End If
End If
If Me.PaymentReturnedIndicator Then
If Me.PaymentAmount > 0 Then
MsgBox "If this is a returned check enter a negative figure.", vbOKOnly
Me.PaymentAmount.SetFocus
End If
End If
If Me.PaymentCustomerID = 0 Then
Me.PaymentCustomerID = glngPaymentCustomerID
End If
If gbolNewItem Then
If Me.cboTransactionType = "Payment" Then
Me.txtLastPayment = Date
End If
End If
Me.txtCustomerBalance = (Me.txtCustomerBalance + mcurPayAmount - Me.PaymentAmount)
Me.txtPalletBalance = (Me.txtPalletBalance + mintPallets - Me.txtPallets)
Dim dbsEastern As DAO.Database
Dim rsCustomers As DAO.Recordset
Dim lngCustomerID As Long
Dim strCustomerID As String
Set dbs = CurrentDb()
Set rsCustomers = dbs.OpenRecordset("tblCustomers")
lngCustomerID = Me.PaymentCustomerID
strCustomerID = "CustomerID = " & lngCustomerID
rsCustomers.MoveFirst
rsCustomers.FindFirst strCustomerID
rsCustomers.Edit
rsCustomers!CustomerBalance = Me.txtCustomerBalance
rsCustomers!Pallets = Me.txtPalletBalance
rsCustomers!CustomerLastPaymentDate = Now()
rsCustomers.Update
rsCustomers.Close
Set rsCustomers = Nothing
FormSaveRecord Me
gbolNewItem = False
gbolNewRec = False
Me.cboPaymentSelect.Enabled = True
Me.cboPaymentSelect.SetFocus
Me.cboPaymentSelect.Requery
Me.fsubNavigation.Enabled = True
cmdNormalMode
Proc_Exit:
Exit Sub
Proc_Err:
gdatErrorDate = Now()
gintErrorNumber = Err.Number
gstrErrorDescription = Err.Description
gstrErrorModule = Me.Name
gstrErrorRoutine = "Sub cmdSaveRecord_Click"
gbolReturn = ErrorHandler() ' Display the error message
Resume Proc_Exit
End Sub
When rsCustomers.Update line executes then ODBC - insert failed error - 3146 occurs.
I checked that the error implies the datatype-Mismatch - code 13.
Then I changed the datatype of my table as well, but still not inserting the data.
While Andre showed you to the correct use of the FindFirst function, I find it pointless to open the whole customers table and then search for a single customer, when you can filter the recordset at point of creation to return only the customer you need.
lngCustomerID = Me.PaymentCustomerID
Set rsCustomers = dbs.OpenRecordset("SELECT * FROM tblCustomers WHERE CustomerID =" & lngCustomerID, dbOpenDynaset)
If rsCustomers.EOF Then
Debug.Print "Customer not found"
GoTo Proc_Exit
End If
'safe to update customer at this point
With rsCustomers
.Edit
'....
.Update
End With
You should then probably change rsCustomers to rsCustomer to make more sense.
After rs.FindFirst you must check with If rs.NoMatch Then if you actually found a record to edit.
Use this to find the underlying problem of error 3146 "ODBC-Call failed":
Determine real cause of ODBC failure (error 3146) with ms-access?
I have a problem with a continuous form producing this error the command or action 'GoToRecord' isn't available now, This is the form source:
SELECT Bom.productcode, Bom.code, Bom.Item, Bom.cons, Bom.BomNumber, [Item Names].Type, Bom.Remarks FROM [Item Names] INNER JOIN Bom ON [Item Names].code = Bom.code WHERE (((Bom.productcode)=Forms!FrmNewPo!t0) And ((Bom.BomNumber)=Forms!FrmNewPo!Bom));
This Error Happens when I press a command button with this code on click event:
Private Sub Command204_Click()
DoCmd.OpenForm "Robot"
DoCmd.GoToRecord , , acNewRec
Forms![Robot]![PONumber] = Me.T7
Forms![Robot]![productcode] = Me.t0
Forms![Robot]![OrderQty] = Me.T3
Forms![Robot]![zdate] = Me.T6
Forms![Robot]![Mold] = Me.Mold
Forms![Robot]![Machine] = Me.Machine
Forms![Robot]![Status] = Me.Status
Forms![Robot]![ProductBomNum] = Me.Bom
DoCmd.Close
Dim sql As DAO.Recordset
Set sql = CurrentDb.OpenRecordset("TblPoMaterials", dbOpenDynaset)
DoCmd.SetWarnings False
DoCmd.GoToRecord , , acFirst ' I THINK THE PROBLEM IS HERE
For m = 1 To T8
With sql
.AddNew
!PONumber = T7
!MaterialCode = Code1
!MaterialName = T1
!ProductionDate = T6
!Shift = "none"
!cons = T2
!AdditionPercent = Text324
!MaterialType = Text300
!OrderQty = T3
.Update
End With
DoCmd.GoToRecord , , acNext
Next m
MsgBox "Done", vbInformation, "Saved successfully"
DoCmd.SetWarnings True
t0 = ""
T6 = ""
T7 = ""
T3 = ""
T10 = ""
T10 = ""
Status = ""
BomCombo = ""
Me.ComboMachine = ""
Me.ComboMold = ""
Mold = ""
Machine = ""
T216 = ""
Me.Requery
The robot form appends the header of the form to a table, the SQL appends the detail part to some other table. When the error happened I found the header in the first table but the detail part isn't found in the other table so I suspected the line in the code is causing this problem but I don't know why!
I tried another approach as following:
Private Sub Command204_Click()
DoCmd.OpenForm "Robot"
DoCmd.GoToRecord , , acNewRec
Forms![Robot]![PONumber] = Me.T7
Forms![Robot]![productcode] = Me.t0
Forms![Robot]![OrderQty] = Me.T3
Forms![Robot]![zdate] = Me.T6
Forms![Robot]![Mold] = Me.Mold
Forms![Robot]![Machine] = Me.Machine
Forms![Robot]![Status] = Me.Status
Forms![Robot]![ProductBomNum] = Me.Bom
DoCmd.Close
DoCmd.SetWarnings False
DoCmd.GoToRecord , , acFirst
For m = 1 To T8
DoCmd.OpenQuery "QryAppendMat2"
DoCmd.GoToRecord , , acNext
Next m
MsgBox "Done", vbInformation, "Saved successfully"
DoCmd.SetWarnings True
t0 = ""
T6 = ""
T7 = ""
T3 = ""
'T5 = ""
T10 = ""
T10 = ""
Status = ""
BomCombo = ""
Me.ComboMachine = ""
Me.ComboMold = ""
Mold = ""
Machine = ""
T216 = ""
Me.Requery
The QryAppendMat2 is an append query which does the same job as the previous SQL Statement the code as following:
INSERT INTO TblPoMaterials ( PONumber, MaterialCode, MaterialName, Cons, MaterialType, ProductionDate, Shift, AdditionPercent, OrderQty )
SELECT [Forms]![FrmNewPo]![T7] AS Expr1, [Forms]![FrmNewPo]![Code1] AS Expr2, [Forms]![FrmNewPo]![T1] AS Expr3, [Forms]![FrmNewPo]![T2] AS Expr6, [Forms]![FrmNewPo]![Text300] AS Expr8, [Forms]![FrmNewPo]![T6] AS Expr4, "none" AS Expr5, [Forms]![FrmNewPo]![Text324] AS Expr7, [Forms]![FrmNewPo]![T3] AS Expr9;
But the same problem happened And I don't know why.
I have some Remarks :
-The problem happens in the accde with linked tables not with the accdb database.
-The problem happens one time of five , Meaning it works fine sometimes and other times just don't.
-The same conditions exactly could proceed normally after the problem happens when I try it again.
I need some help guys and so sorry for long question, but I tried to cover all possible questions.
Sounds like should be using form/subform arrangment. – June7 43 mins ago
Try this:
me.SetFocus
DoCmd.GoToRecord , , acNext
I have the problem that the combobox in access 2010 displays just 1249 values of the 1278. Is there a possibility to increase the max number of values in a combobox in access?
Here is a code sample:
If not rs.EOF Then
rs.MoveFirst
frm.FName.RowSource = ""
frm.FNameLux.RowSource = ""
Do Until rs.EOF
If rs![id] <> -1 And rs![id] <> -2 Then
If (rs!KID <> 2 And rs!KID <> 8) Then
If IsNull(rs![Name]) = False Then
frm.FName.AddItem rs![Name] & ";" & rs![id]
Debug.Print rs!Name 'The program writes all values in the combobox, but when I look in the form, I don't see all values
End If
End If
If (rs!KID = 2 Or rs!KID = 8) Then
If IsNull(rs![Name]) = False Then
frm.FNameLux.AddItem rs![Name] & ";" & rs![id]
End If
End If
End If
rs.MoveNext
i = i + 1
Loop
End If
rs is the recordset. Is there any idea how to solve it or what I have to do?
Apparently the RowSource property for RowSourceType = Value list is limited to 16bit integer length (2^15 = 32768) or a bit below.
Test code for a 2-column combobox:
Private Sub btValues_Click()
Dim i As Long
DoCmd.Hourglass True
Me.cboValues.RowSource = ""
For i = 1 To 5000
Me.cboValues.AddItem "Number " & Format(i, "0000") & ";" & i
Next i
DoCmd.Hourglass False
Debug.Print Len(Me.cboValues.RowSource)
End Sub
The combobox is filled up until "Number 1991", output is 32739.
So the problem is not the number of rows, but the total string length. If I shorten the text, it goes up to "Nr 2604" (32744 chars).
You'll have to use RowSourceType = Table/query to show all items.
Edit
Create queries as rowsource for the comboboxes. As far as I can see, there is nothing in your code that cannot be done in a WHERE clause.
E.g. for FName
SELECT Name, id
FROM yourTable
WHERE id <> -1 AND id <> -2
AND KID <> 2 AND KID <> 8
AND Name IS NOT NULL
If your VBA code could not be recreated in SQL, you'd have to insert the recordset rows you want into a temp table, and use this table as rowsource.
I have two linked Tables 'tblPatients' and 'tblDSA' and two continues forms 'frmPatients' and 'frmDSA'. When I create a new patient via 'frmPatient'I would like to add a new record for that patient in 'frmDSA' without closing the form.
On 'frmPatients' next to each record there is a button 'SaveNewRecord' that does the following:
(1)saves a new record to 'tblPatients' and also filters
(2) opens 'frmDSA' to display related records to that Patients.
Here is the filtering code:
If Not Me.NewRecord Then
DoCmd.OpenForm "DSAfrm", _
WhereCondition:="LABCODE=" & Me.LABCODE
End If
Here is what happens:
After the 'DSAfrm' pops up and I try to enter a new record I get the following error."can not add records joint key of table 'TableName' not in record-set"
The new patient has been save to 'tblPatients' but Access is not letting me add any new records. Please help!
Here is the code that I use to save the new records:
Private Sub Command385_Click()
Dim db As DAO.Database
Dim PatientTable As DAO.Recordset
Dim DSAtable As DAO.Recordset2
Dim errMsg As String 'Where we will store error messages
Dim errData As Boolean 'Default = False if we have an error we will set it to True.
Dim i As Integer 'used as a counter in For..Next loops.
Dim x As Integer 'used as counter in For..Next loops.
Dim errorArray(0 To 3) As String 'Array to hold the error messages so we can 'use them if needed.
If Me.LABCODE.Value = "" Then
errorArray(0) = "Must Enter Labcode."
errData = True
End If
If Me.LastName.Value = 0 Then
errorArray(1) = "Must Enter Patient Number"
errData = True
End If
If Me.FirstName.Value = "" Then
errorArray(2) = "Must Enter Insurance Type"
errData = True
End If
If Me.MRN.Value = "" Then
errorArray(3) = "Must Enter Intake Nurse"
errData = True
End If
'MsgBox "errData = " & errData
If errData = True Then
i = 0
x = 0
For i = 0 To 3
If errorArray(i) <> "" Then
If x > 0 Then
errMsg = errMsg & vbNewLine & errorArray(i)
Else
errMsg = errorArray(i)
x = x + 1
End If
End If
Next i
MsgBox errMsg & vbNewLine & "Please try again."
errMsg = ""
Me.LABCODE.SetFocus
Exit Sub
End If
Set db = CurrentDb()
Set PatientTable = db.OpenRecordset("tblPatients")
With PatientTable
.AddNew
!LABCODE = Me.LABCODE.Value
!LastName = Me.LastName.Value
!FirstName = Me.FirstName.Value
!MRN = Me.MRN.Value
!MRNTwo = Me.MRN2.Value
Debug.Print Me.MRN.Value
'!CPI#2 = Me.MRN2.Value
!Kidney = Me.cbKidney.Value
!Heart = Me.cbHeart.Value
!Lung = Me.cbLung.Value
!Liver = Me.cbLiver.Value
!Pancreas = Me.cbPancreas.Value
!DateLogged = Format(Date, "MM/DD/YY")
.Update
End With
'End If
Set DSAtable = db.OpenRecordset("tblDSA")
With DSAtable
.AddNew
!LABCODE = Me.LABCODE.Value
.Update
End With
'Let the user know it worked.
MsgBox "This patient has been added successfully.", vbOKOnly
'If Not Me.NewRecord Then
DoCmd.OpenForm "DSAfrm", _
WhereCondition:="LABCODE=" & Me.LABCODE
'End If
End Sub
I have a number of dates on a form and started out validating them each individually. Wanted to replace all these checks with one function which could be called from each of their 'before update' events. Problem is that I can't get the focus to remain on the control when validation fails.
Public Function CheckDate(datefield As TextBox) As Integer
Dim this_date As Date
Dim DOB As Date
Dim first_seen As Date
this_date = Conversion.CDate(datefield.text)
DOB = [Forms]![generic]![date_of_birth]
first_seen = [Forms]![generic]![date_first_seen]
If Not IsNull(this_date) Then
'date of birth must precede any other date
If this_date < DOB Then
MsgBox "This date precedes the date of birth", vbExclamation, "Invalid date"
CheckDate = -1
Exit Function
End If
'date can't be in the future
If this_date > DateTime.Date Then
MsgBox "This date is in the future", vbExclamation, "Invalid date"
CheckDate = -1
Exit Function
End If
'all investigation/treatment dates must be >= date first seen
If Not IsNull(first_seen) Then
If this_date < first_seen Then
MsgBox "This date precedes the date patient was first seen", vbExclamation, "Invalid date"
CheckDate = -1
Exit Function
End If
End If
End If
End Function
Within
Private Sub xray_date_BeforeUpdate(Cancel As Integer)
I've tried:
Call CheckDate(xray_date)
which displays correct message but moves focus from control instead of keeping it there for editing.
Cancel = CheckDate(xray_date)
doesn't appear to do anything, allowing invalid data to be passed for storage. So what way should I be calling the function in order to have the BeforeUpdate's Cancel event set to True when validation fails?
I struggled to understand your sample code, so I built a table with Date/Time fields: date_of_birth; date_first_seen; and xray_date. Then built a form based on that table with these text boxes bound to those fields: txtDate_of_birth; txtDate_first_seen; and txtXray_date.
This is my form's code module, and AFAICT it validates txtXray_date as you want.
Option Compare Database
Option Explicit
Private Function CheckDate(ctlDate As TextBox) As Integer
Const clngChecks As Long = 3 ' change this to match the number
' of conditions in the For loop
Const cstrTitle As String = "Invalid date"
Dim i As Long
Dim intReturn As Integer
Dim lngButtons As Long
Dim strPrompt As String
Dim strTitle As String
lngButtons = vbExclamation
strPrompt = vbNullString ' make it explicit
intReturn = 0 ' make it explicit
For i = 1 To clngChecks
Select Case i
Case 1
'date of birth must precede any other date
If ctlDate < Me.txtDate_of_birth Then
strPrompt = "This date precedes the date of birth"
Exit For
End If
Case 2
'date can't be in the future
If ctlDate > DateTime.Date Then
strPrompt = "This date is in the future"
Exit For
End If
Case 3
'all investigation/treatment dates must be >= date first seen
If ctlDate < Me.txtDate_first_seen Then
strPrompt = "This date precedes the date patient was first seen"
Exit For
End If
End Select
Next i
If Len(strPrompt) > 0 Then
MsgBox strPrompt, lngButtons, cstrTitle
intReturn = -1
End If
CheckDate = intReturn
End Function
Private Sub txtXray_date_BeforeUpdate(Cancel As Integer)
Cancel = CheckDate(Me.txtXray_date)
End Sub