I'm very new to VBA so I'm not even sure if I'm heading in the right direction.
I'm using Access 2010 and I've created a form where you search for an ID and then you click to add a new record for multiple timepoints (e.g follow-up form for timepoint 1, 2, 3, 4).
I have a StudyPeriod field (long integer) where you select from a list (via query number + text). I want an error box to come if that time period has already been entered.
I've been trying to use this code but it keeps coming up with the 3464 runtime error and the de-bug highlights the If Me. line.
What am I doing wrong?
Private Sub StudyPeriod_AfterUpdate()
Dim StudyPeriod As String
Dim StLinkCriteria As String
StudyPeriod = Me.StudyPeriod.Value
StLinkCriteria = "[StudyPeriod] = " & "'" & StudyPeriod & "'"
' If line below returns error
If Me.StudyPeriod = DLookup("[StudyPeriod]", "3_Questionnaire", StLinkCriteria) Then
MsgBox "This questionnaire has already been entered for this participant." _
& vbCr & vbCr & "Please check RegID or Summary table.", vbInformation, _
"Duplicate information"
Me.Undo
End If
End Sub
Your StudyPeriod field in your 3_Questionnaire table is a numeric datatype (Long Integer). So do not include quotes before and after the value of your StudyPeriod variable when you build the StLinkCriteria string:
'StLinkCriteria = "[StudyPeriod] = " & "'" & StudyPeriod & "'"
StLinkCriteria = "[StudyPeriod] = " & StudyPeriod
If Me.StudyPeriod = DLookup("[StudyPeriod]", "3_Questionnaire", StLinkCriteria) Then
Related
I am trying to write a VBA code on msaccess to validate the data entries to avoid duplicates on a fault log database. It works for the stLinkCriteria which is a string datatype (short text) but not for stDCriteria which is a date data type... it keeps throwing an error "type mismatch" or "datatype mismatch" on this line
stDCriteria = "[datelogged] = #" & DateTime & "#"
The stDCriteria is showing 12:00:00am when I hover my mouse on the code
Although the data type for datelogged is Date/Time in the database...
Private Sub Form_AfterUpdate()
Dim NewTerminal As String
Dim stLinkCriteria As String
Dim DateTime As Date
Dim stDCriteria As Date
NewTerminal = Me.cboTerID.Value
DateTime = Me.txtDateLogged.Value
stLinkCriteria = "[serialptrid] = " & NewTerminal & ""
stDCriteria = "[datelogged] = #" & DateTime & "#"
If Me.SerialptrID = DLookup("[serialptrid]", "Fault_Log", stLinkCriteria) Then
If Me.DateLogged = DLookup("[datelogged]", "Fault_Log", stDCriteria) Then
MsgBox "This terminal " & NewTerminal & ", " & DateTime & ", has already been entered in this database." _
& vbCr & vbCr & "Please check terminal selected", vbInformation, "Duplicate information"
Me.Undo
End If
End If
End Sub
This code attempts to assign a string value to stDCriteria:
stDCriteria = "[datelogged] = #" & DateTime & "#"
So you must declare that variable as String instead of Date.
Dim stDCriteria As String
Also you can apply a yyyy-m-d format to your DateTime value. That format avoids confusion about whether your date is m/d/yyyy or d/m/yyyy format.
stDCriteria = "[datelogged] = #" & Format(DateTime, "yyyy-m-d") & "#"
I have an app that searches through customer information on a SQL Server database.
There are three forms:
The first allows the user to lookup info based on several different criteria, like Account no, Last name Phone Number, etc.
The second form correctly displays the information from the first form.
I want to open a third form based on a value in the result set on the second form, a field called Master_ID.
I have created a Global variable that stores the contents of the Master_ID field on the second form when the Master_ID field is clicked.
Then I want to execute the on click event on a button that contains the following code:
Private Sub tranHisBtn_Click()
Dim transferSQL As String
transferSQL = "SELECT dbo_Master_Accounts.Master_ID, dbo_Master_Accounts.FirstName, dbo_Master_Accounts.LastName, dbo_Transaction_Table.Date_of_Transaction, Format([dbo_Transaction_Table]![Time_of_Transaction],""hh:nn:ss ampm"") AS TranTime, dbo_Transaction_Table.Sku, dbo_Transaction_Table.Description, Right([dbo_Transaction_Table]![Description],6) AS tranAccnt, [dbo_Transaction_Table]![ArAmt]*-1 AS Amnt, dbo_Master_Accounts.Master_ID " & vbCrLf
transferSQL = transferSQL + "FROM dbo_Master_Accounts INNER JOIN dbo_Transaction_Table ON dbo_Master_Accounts.Master_ID = dbo_Transaction_Table.Account_Number " & vbCrLf
transferSQL = transferSQL + "WHERE (((dbo_Transaction_Table.Description) Like ""%Transfer To%"") AND ((dbo_Master_Accounts.Master_ID)=" & Chr$(34) & GBL_Master_Id & Chr$(34) & ")) " & vbCrLf
transferSQL = transferSQL + "ORDER BY dbo_Transaction_Table.Date_of_Transaction, Format([dbo_Transaction_Table]![Time_of_Transaction],""hh:nn:ss ampm"");"
Dim trancon As ADODB.Connection
Set trancon = CurrentProject.Connection
Dim tranRs As New ADODB.Recordset
tranRs.ActiveConnection = trancon
tranRs.CursorType = adOpenStatic
tranRs.Open transferSQL
'DoCmd.OpenForm "TransferbyNumFM" ', , , "Master_Id = 'transRs.fields(0)'"
MsgBox "good"
End Sub
I can't figure out how to set the record source for the third form. Everything runs perfectly until I try to open the third form.
As I said: Open the form with DoCmd and set the recordsource of the Form object in the OnOpen Event of the 3rd form to the SQL string you have. No need to create a recordset, either. And never try to pass a recordsource as a filter in a DoCmd.OpenForm
Oh, and my error: since you have a global variable (i.e. a public variable declared in a module) you don't even need to pass it as an OpenArgs, you can simply do the following on Button Click
DoCmd.OpenForm "TransferbyNumFm"
and then, in the class module of Form3 do
Option Compare Database
Option Explicit
Private Sub Form_Open(Cancel As Integer)
Dim transferSQL As String
transferSQL = _
"SELECT dbo_Master_Accounts.Master_ID, " & _
"dbo_Master_Accounts.FirstName, " & _
"dbo_Master_Accounts.LastName, " & _
"dbo_Transaction_Table.Date_of_Transaction, " & _
"Format([dbo_Transaction_Table]![Time_of_Transaction],'hh:nn:ss ampm') AS TranTime, " & _
"dbo_Transaction_Table.Sku, dbo_Transaction_Table.Description, " & _
"Right([dbo_Transaction_Table]![Description],6) AS tranAccnt, " & _
"[dbo_Transaction_Table]![ArAmt]*-1 AS Amnt " & _
"FROM dbo_Master_Accounts " & _
"INNER JOIN dbo_Transaction_Table ON dbo_Master_Accounts.Master_ID = dbo_Transaction_Table.Account_Number " & _
"WHERE(((dbo_Transaction_Table.Sku) Like '%Transfer%')) " & _
"ORDER BY dbo_Transaction_Table.Date_of_Transaction"
Me.RecordSource = transferSQL
End Sub
The Recordsource of Form3 can be unassigned before this point, though you will need it to add fields (but you can remove it later on)
I am trying to create a form that allows you to return results based on multiple criteria.
I have FirstName field, LastName field, and State Field.
I also have an text boxes named searchFirst, searchLast, searchState where users can input criteria.
The search button will execute the following code once clicked.
Private Sub mySearchQuery_Click()
Dim filter As String
Dim rtFirstName As String
Dim rtLastName As String
Dim rtState As String
rtFirstName = Me.searchFirst.Value
rtLastName = Me.searchLast.Value
rtState = Me.searchState.Value
If Not IsNull(rtFirstName) Then
If Not IsNull(filter) Then filter = filter & " AND "
filter = filter & "(FirstName like""*" & rtFirstName & "*"")"
End If
If Not IsNull(rtLastName) Then
If Not IsNull(filter) Then filter = filter & " AND "
filter = filter & "(LastName like""*" & rtLastName & "*"")"
End If
If Not IsNull(rtState) Then
If Not IsNull(filter) Then filter = filter & " AND "
filter = filter & "(State LIKE""*" & rtState & "*"")"
End If
' Now re-construct the SQL query '
Dim sql As String
sql = "SELECT * FROM MainData"
If Not IsNull(filter) Then
sql = sql & " WHERE " & filter
End If
Me.RecordSource = sql
'SubForm.Form.RecordSource = sql
End Sub
I am getting the following error below.
Run-time error '3075': Syntax error (missing operator) in query
expression 'AND (FirstName like"*tracy*") AND (lastName like"*Smith*")
AND (State LIKE"*ga*")'.
I am not sure why AND was included at the beginning of the search query?
I am not sure why AND was included at the beginning of the search
query?
Since you have Dim filter As String, filter can never contain Null. That means these If conditions ... If Not IsNull(filter) ... will always be True.
Similarly, Not IsNull(rtFirstName), Not IsNull(rtLastName), and Not IsNull(rtState) will always be True.
The net result is the code adds another condition piece to your filter string regardless of whether or not the corresponding search text box contains anything, and each of those pieces is prefixed with " AND ".
With those points in mind, you could refactor your code to add a filter segment only when you have something in the corresponding search text box and decide when to include " AND ". However I find it simpler to include " AND " for each of them and then strip away the very first " AND " from filter before adding it to the WHERE clause.
Private Sub mySearchQuery_Click()
Dim strSelect As String
Dim strWhere As String
If Len(Trim(Me!searchFirst.Value) & vbNullString) > 0 Then
strWhere = strWhere & " AND FirstName Like ""*" & Me!searchFirst.Value & "*"""
End If
If Len(Trim(Me!searchLast.Value) & vbNullString) > 0 Then
strWhere = strWhere & " AND LastName Like ""*" & Me!searchLast.Value & "*"""
End If
If Len(Trim(Me!searchState.Value) & vbNullString) > 0 Then
strWhere = strWhere & " AND State Like ""*" & Me!searchState.Value & "*"""
End If
' Now re-construct the SQL query
strSelect = "SELECT * FROM MainData"
' only add WHERE clause if we have something in strWhere
If Len(strWhere) > 0 Then
' use Mid() to ignore leading " AND "
strSelect = strSelect & " WHERE " & Mid(strWhere, 6)
End If
Debug.Print strSelect ' <- inspect this in Immediate window; Ctrl+g will take you there
' enable one of these RecordSource lines after confirming Debug.Print shows you what you need
'Me.RecordSource = sql
'SubForm.Form.RecordSource = sql
End Sub
This question was asked in the topic with a similar name earlier, but the answer provided didn't really indicate HOW those events would help determine whether somebody was typing in the combo box or selecting an item in the list. I think that it really answered the other question about how to determine when somebody was done typing, but without seeing the event handlers, I can't be sure.
Unfortunately, I'm new here and don't have enough reputation to post a comment asking for clarification, so I have to start a new question. Here's what I'm trying to do:
I have a form with a combo box in the Header and, as I type in the combo box, I want the characters that I've typed to be used as a filter on the Details part of the form. Both the combo box control source and the form's record source use the same query string.
I've tried numerous iterations of the code below, but I can't get it to work correctly.
Private Sub cmbAppName_Change()
Dim strApp As String
Dim nSelStart As Integer
Dim nSelLen As Integer
Dim nSelected As Integer
Dim strMsg As String
On Error GoTo ERR_SUB
strMsg = ""
Me.cmbAppName.SetFocus
' Get current selection details
nSelStart = Me.cmbAppName.SelStart
nSelLen = Me.cmbAppName.SelLength
nSelected = Me.cmbAppName.ListIndex
Me.cmbAppName.SetFocus
strApp = Nz(Me.cmbAppName.Text, "")
Debug.Print "Index = " & nSelected & "; SelStart = " & nSelStart & "; SelLen = " & nSelLen
If nSelected = -1 Then
Debug.Print "Change by typing: " & strApp
Else
Debug.Print "Change by list selection: " & strApp
End If
' Get the part of the text that the user has typed
If nSelStart > 0 Then
strApp = Left(strApp, nSelStart)
Debug.Print "App piece = '" & strApp & "'"
End If
' If there is text, set a filter (MatchAppName = InStr(strApp, datbase_column_value)
If strApp <> "" Then
Me.Filter = "MatchAppName('" & strApp & "', " & DCApplications_Application_Col & ") > 0"
Me.FilterOn = True
' Me.txtApplication.SetFocus
' Call DoCmd.FindRecord(strApp, acStart, False, acSearchAll, False, acCurrent, True)
' Me.cmbAppName.SetFocus
Else
Me.Filter = ""
Me.FilterOn = False
End If
EXIT_SUB:
' Restore the selection in the combo box's text box
Me.cmbAppName.SetFocus
Me.cmbAppName.SelStart = nSelStart
Me.cmbAppName.SelLength = nSelLen
Exit Sub
ERR_SUB:
If ERR.Number = 2185 Then
strApp = Nz(Me.cmbAppName.Value, "")
Me.cmbAppName.SetFocus
Debug.Print "Using " & strApp
Resume Next
End If
Me.Filter = ""
Me.FilterOn = False
Debug.Print ErrorMessage(ERR.Description, "cmbAppName_Change", ERR.Number, "Value = '" & Me.cmbAppName.Value & "'", False)
Resume EXIT_SUB
End Sub ' cmbAppName_Change
As you can see from the error handling code, I'd often get an error 2185 telling me that my control didn't have focus when using the Text property despite having a SetFocus call right before it.
If somebody selects from the list (either by clicking or moving the selection), I'd like to go to that record, but I at least need the above piece working first.
After searching the Web, I found out that a Details section with zero records causes the 2185 error. Apparently, filtering like that causes problems when all records are filtered out.
The solutions on the Web said that you can set the Allow Additions property of the form to True, but that always displays one row in the Details section. This can be especially confusing if the rows in the Details section contain controls, which will be displayed in the "addition" row. Also, I would still get an error typing additional characters after the one that caused the Details section to have zero records.
Eventually, I replaced the combo box with a simple text control to filter the Details section. When the Details section has rows, I turn Allow Additions off and make the controls visible; when it doesn't have rows, I turn Allow Additions on and hide the controls.
Here's the code that I used:
Private Sub txtApplicationFilter_Change()
Dim strApp As String
Dim nSelStart As Integer
Dim nSelLen As Integer
Dim strFilter As String
Dim strQuery As String
Dim strWhere As String
Dim nRecs As Integer
On Error GoTo ERR_SUB
' Save text selection
nSelStart = Me.txtApplicationFilter.SelStart
nSelLen = Me.txtApplicationFilter.SelLength
' Get application name typed and selection information
strApp = Nz(Me.txtApplicationFilter.Text, "")
strFilter = "[" & DCApplications_Application_Col & "] LIKE '*" & EscapeQuotes(strApp) & "*'"
nRecs = DCount("[" & DCApplications_Application_Col & "]", LocalTableName(DCApplications_Tab), strFilter)
' Kludge code to prevent various errors (like 2185) when no records are returned in the form
Call UpdateList(nRecs)
' Update the record source to reflect the filtered list of apps
strWhere = " WHERE APPS." & strFilter
strQuery = strSelect & strFrom & strWhere & strOrderBy
Me.RecordSource = strQuery
' 20200423 SHM: Restore or update filter to avoid issues with Delete and Backspace and applications with spaces in their names
Me.txtApplicationFilter.SetFocus
Me.txtApplicationFilter = strApp
Me.txtApplicationFilter.SelStart = nSelStart
Me.txtApplicationFilter.SelLength = nSelLen
EXIT_SUB:
Me.btnAddNew.enabled = (Nz(Me.txtApplicationFilter, "") <> "")
Exit Sub
ERR_SUB:
' NOTE: ErrorMessage is a helper function that basically displays a form displaying the error
Call ErrorMessage(ERR.Description, "txtApplicationFilter_Change", ERR.Number, "Filter = " & strApp & " Records = " & nRecs)
Resume EXIT_SUB
Resume Next
End Sub ' txtApplicationFilter_Change
Private Sub UpdateList(nRecs As Integer)
Dim bShowControls As Boolean
On Error GoTo ERR_SUB
bShowControls = (nRecs > 0)
' Kludge code to turn off checkbox control source
If bShowControls Then
strSelect = strSelectStart & ", (" & strAppUser & ") AS " & strCtrlSource
Me.chkTestedByMe.ControlSource = strCtrlSource
Else
strSelect = strSelectStart
Me.chkTestedByMe.ControlSource = ""
End If
' Kludge code to prevent various errors (like 2185) when no records are returned in the form
' Turning on AllowAdditions prevents errors when no records are returned.
' However, that puts an empty row in the form, but the controls are showing, so we have to hide them to prevent confusing the user.
Me.AllowAdditions = Not bShowControls
Me.btnAddExisting.visible = bShowControls
Me.chkTestedByMe.visible = bShowControls
EXIT_SUB:
Exit Sub
ERR_SUB:
Call ErrorMessage(ERR.Description, "UpdateList", ERR.Number, " Records = " & nRecs)
Resume EXIT_SUB
Resume Next
End Sub ' UpdateList
I would use a work around to settle this issue
A simple code bellow demonstrate the work around using Tag property of Combo Box and keypress event along with change event, I hope it can be applied in your code
Private Sub Combo2_Change()
If Combo2.Tag = 1 Then
Text4 = "change - from key"
Else
Text4 = "change - from select"
End If
Combo2.Tag = 0
End Sub
Private Sub Combo2_KeyPress(KeyAscii As Integer)
Combo2.Tag = 1
End Sub
Don't forget to set Tag property of Combo Box to 0 on design view to avoid error at comparing empty Tag with number
Can anyone solve my issue
Form: SB_1 (this is a Customer Invoice creation form)
Form: Add_NewRelations (this is a Customer details adding form)
I have used a VBA code in Form: SB_1 on a cmd (Button) for Data passing from one form to another form of Add_NewRelations for New Customer details are needed to update.
So that VBA working is good as per Code Tag. But some of exist customer details are no need to update into Form: Add_NewRelations. So in this case i have added IF Statement with DCount in the VBA code.
When i added If statement with DCount then whole VBA is didn't working... i think DCount is wrong... how can i correction it??
Can anyone please replay how to solve this problem??
Private Sub Button_Click()
On Error GoTo ErrorHandler
'Me.Refresh
Dim strCriteria As String
strCriteria = "CIDCustomer = '" & Trim(Trim(Me!RID) & " " & Trim(Me!RName)) & "'"
'If DCount("*", "CIDCustomer", "RelationsQry") > 0 Then
'Cancel = True
'Else
If DCount("*", "RelationsQry", strCriteria) > 0 Then
Cancel = True
Else
'If Not IsNull([Customer]) Then
'Me.Visible = False
DoCmd.OpenForm "Add_NewRelations", acNormal, , , , acWindowNormal
Forms![Add_NewRelations].Form.RID = Me.CID2
Forms![Add_NewRelations].Form.RName = Me.Customer
Forms![Add_NewRelations].Form.RType.Value = "Customer"
Forms![Add_NewRelations].Form.Address = Me.Address
Forms![Add_NewRelations].Form.TINNumber = Me.TINNumber
Forms![Add_NewRelations].Form.TownVLG = Me.TownVLG
Forms![Add_NewRelations].Form.RName.SetFocus
'Forms![Add_NewRelations].Visible = False
'DoCmd.Close
End If
ErrorHandler:
End Sub
To pass the quotes into the SQL you need to escape them, and you need additional single quotes as well for the elements of the criteria.
Instead of:
strCriteria = "CIDCustomer = '" & Trim(Trim(Me!RID) & " " & Trim(Me!RName)) & "'"
try
strCriteria = "" "CIDCustomer = '" & Trim(Trim(Me!RID) & "' & " " & '" Trim(Me!RName)) & "'" ""