Can anyone help me identify what's wrong with this code? If I change DOB in the table to short text and DIM it as a string, the code works. But, with DOB as a date field, DIM as date, I am getting this error message.
"Run-time error '3464'
Data Type mismatch in criteria expression"
When I click on debug, the line bolded below is highlighted in yellow.
Private Sub DOB_AfterUpdate()
Dim DOB As Date
Dim FirstName As String
Dim LastName As String
Dim stLinkCriteria As String
Dim PIN As Integer
'Assign the entered customer name and address to a variable
NewJII = Me.FirstName.Value
NewJII2 = Me.LastName.Value
NewDOB = Me.DOB.Value
stLinkCriteria = "[FirstName] = " & "'" & NewJII & "' and [LastName] = " & "'" & NewJII2 & "' And [DOB] = " & "'" & NewDOB & "'"
**If Me.FirstName & Me.LastName & Me.DOB = DLookup("[FirstName]",
"TblPersonLog", stLinkCriteria) Then**
MsgBox "This Customer, " & stLinkCriteria & " has already been entered in database." _
& vbCr & vbCr & "with DOB " & NewDOB & "" _
& vbCr & vbCr & "Please check Customer name and Date Of Birth again.", vbInformation, "Duplicate information"
Cancel = True
End If
End Sub
Really appreciate any guidance!! I've been trying to troubleshoot this for days. Not very strong in VBA.
First, you can't use DLookup that way. Second, if you wish to cancel, use the BeforeUpdate event. Third, as stated by Tim, use the correct syntax for the date criteria.
Thus, it could be something like this:
Private Sub DOB_BeforeUpdate(Cancel As Integer)
Dim FirstName As String
Dim LastName As String
Dim NewDOB As Date
Dim stLinkCriteria As String
If Not IsNull(Me!DOB.Value) Then
' Assign the entered customer name and DOB to variables.
FirstName = Nz(Me!FirstName.Value)
LastName Nz(Me!LastName.Value)
NewDOB = Me!DOB.Value
stLinkCriteria = "[FirstName] = '" & FirstName & "' And [LastName] = '" & LastName & "' And [DOB] = #" & Format(NewDOB, "yyyy\/mm\/dd") & "#"
Cancel = Not IsNull(DLookup("[FirstName]", "TblPersonLog", stLinkCriteria))
If Cancel = True Then
MsgBox "This Customer, " & FirstName & " " & LastName & ", has already been entered in the database" _
& vbCr & vbCr & "with DOB " & NewDOB & "." _
& vbCr & vbCr & "Please check Customer name and Date Of Birth again.", vbInformation, "Duplicate information"
End If
End If
End Sub
Related
I developed a macro to save attached files from selected emails with a subject depending on the body.
I would like to make the macro select the emails instead of doing it manually.
Goal: Select emails depending on their subject and an specific date range.
Filter mails received in a specified date range which corresponds with subject "Ordenes" and come from "ordenes#ordenes.com". This must be done without reading every single email on the inbox folder as I do not have the option of moving historical ones to another folder (shared email).
Select the mails that match the previous step and then call a macro called "SaveAttachements".
I've been checking Items.Restrict, Items.Find, Explorer.Selection, Explorer.AddToSelection but I don't seem to be getting the right concept.
You can filter (select) emails with .Restrict, which allows multiple conditions.
Option Explicit
Private Sub restrict_SenderEmailAddress_Subject_DateRangeRecent()
Dim itms As Items
Dim resItms As Items
Dim itm As Object
Dim srchSenderEmailAddress As String
Dim srchSubject As String
Dim dateRangeDays As Long
Dim srchDatePeriod As String
Dim strFilterBuild As String
Dim resItmsBuild As Items
Dim strFilter As String
Dim i As Long
Set itms = Session.GetDefaultFolder(olFolderInbox).Items
'For i = 1 To itms.Count
' Debug.Print itms(i).SenderEmailAddress
'Next
srchSenderEmailAddress = "ordenes#ordenes.com"
' If you cannot get the quotes right all at once, build the filter.
strFilterBuild = "[SenderEmailAddress] = '" & srchSenderEmailAddress & "'"
Debug.Print strFilterBuild
Set resItmsBuild = itms.Restrict(strFilterBuild)
If resItmsBuild.Count = 0 Then
Debug.Print "No " & srchSenderEmailAddress & " email."
'MsgBox "No " & srchSenderEmailAddress & " email."
Exit Sub
End If
srchSubject = "Ordenes"
strFilterBuild = strFilterBuild & " And [Subject] = '" & srchSubject & "'"
Debug.Print strFilterBuild
Set resItmsBuild = itms.Restrict(strFilterBuild)
If resItmsBuild.Count = 0 Then
Debug.Print "No " & srchSenderEmailAddress & " email with subject " & srchSubject
'MsgBox "No " & srchSenderEmailAddress & " email with subject " & srchSubject
Exit Sub
End If
' adjust as needed
dateRangeDays = 1400
srchDatePeriod = Format(Date - dateRangeDays, "yyyy-mm-dd")
'Debug.Print srchDatePeriod
strFilterBuild = strFilterBuild & " And [ReceivedTime] > '" & srchDatePeriod & "'"
Debug.Print strFilterBuild
Set resItmsBuild = itms.Restrict(strFilterBuild)
resItmsBuild.sort "[ReceivedTime]", True
If resItmsBuild.Count = 0 Then
Debug.Print "No " & srchSenderEmailAddress & " email with subject " & srchSubject & " in the last " & dateRangeDays & " days."
'MsgBox "No " & srchSenderEmailAddress & " email with subject " & srchSubject & " in the last " & datePeriodDays & " days."
Exit Sub
End If
' This should match the final strFilterBuild to confirm it can be done all at once.
strFilter = "[SenderEmailAddress] = '" & srchSenderEmailAddress & "' And [Subject] = '" & srchSubject & "' And [ReceivedTime] > '" & srchDatePeriod & "'"
Debug.Print strFilter
Set resItms = itms.Restrict(strFilter)
resItms.sort "[ReceivedTime]", True
If resItms.Count = 0 Then
MsgBox "No " & srchSubject & " email on " & srchDatePeriod
End If
For i = 1 To resItms.Count
Debug.Print resItms(i).ReceivedTime & ": " & resItms(i).Subject
'SaveAttachments resItms(i)
Next
End Sub
I have a few controls (Combobox's I call DDL's) that I use as filters for a dynamic query, shown below.
I have a region, division filter - and BCI/BCV/ABC/etc dropdowns.
When I select the region and division, the output list box correctly filters out everything except THOSE region/divisions. Good.
The problem comes in when I use the other DDL's, ABD/BCI/etc... those do not filter out correctly and I think it is with my and/or clauses below.
Can anyone see anything glaring or point me in the right direction to get this so that every control and ddl element filters out the data it is intended for - while keeping it in a format where the SQL itself is part of a string, like in my example?
Private Sub goBtn_Click()
strSQL = "SELECT [account_number], [BCI_Amt], [BCV_Amt],[ABC_Amt], [other_Amt], " & _
"[BCI_Amt]+[BCV_Amt]+[ABC_Amt]+[other_MRC_Amt], Division_Name, Region_Name, " & _
"Tier, Unit_ID, Name, Description_2 " & _
"FROM dbo_ndw_bc_subs " & _
"WHERE DivisionDDL = [Division_Name] and RegionDDL = [Region_Name] " & _
" and ( [BCI_Ind] = CheckBCI.value or [BCV_Ind] = CheckBCV.value or [ABC_Ind] = CheckABC.value " & _
" or BCIServiceDDL = [Tier]" & _
" or BCVServiceDDL = [Description_2]" & _
" or ABCServiceDDL = [Unit_ID] )" & _
"ORDER BY 6 asc"
Me.output1.RowSource = strSQL
End Sub
One of the combo box DDL control codes. There are check boxes that make the combo box visible or not visible.
Private Sub CheckBCV_Click()
If Me.CheckBCV = vbTrue Then
Me.BCVServiceDDL.Visible = True
Me.BCVServiceDDL = "Select:"
strSQL = "SELECT Distinct subs.[Description_2] FROM dbo_ndw_bc_subs "
Me.BCVServiceDDL.RowSource = strSQL
Me.BCVServiceDDL.Requery
Else
Me.BCVServiceDDL.Visible = False
Me.BCVServiceDDL = ""
End If
End Sub
Edit: Added additional code to the first code block for context, and updated some comments.
To reiterate the point of my question - Since some of the DDL's work as expected while the others do not. Is it in the AND/OR section where I have a problem - or am I forced to do an IF/IIF statement in the select. (And if I do this IF solution - how would that be incorporated into a string the way I have it now, I have not seen an example of this in my research on a resolution).
I think your top code sample should read more like this:
Private Sub goBtn_Click()
Dim strSQL As String
Dim strWhere As String
Dim strOp As String
strSQL = "SELECT [account_number], [BCI_Amt], [BCV_Amt],[ABC_Amt], [other_Amt], " & _
"[BCI_Amt]+[BCV_Amt]+[ABC_Amt]+[other_MRC_Amt], Division_Name, Region_Name, " & _
"Tier, Unit_ID, Name, Description_2 " & _
"FROM dbo_ndw_bc_subs "
strWhere = ""
strOp = ""
If Not IsNull(Me.DivisionDDL.Value) Then
strWhere = strWhere & strOp & "(Division_Name = """ & Me.DivisionDDL.Value & """)"
strOp = " And "
End If
If Not IsNull(Me.RegionDDL.Value) Then
strWhere = strWhere & strOp & "(Region_Name = """ & Me.RegionDDL.Value & """)"
strOp = " And "
End If
If Me.CheckBCI.Value Then
strWhere = strWhere & strOp & "(Tier = """ & Me.BCIServiceDDL.Value & """)"
strOp = " And "
End If
If Me.CheckBCV.Value Then
strWhere = strWhere & strOp & "(Description_2 = """ & Me.BCVServiceDDL.Value & """)"
strOp = " And "
End If
If Me.CheckABC.Value Then
strWhere = strWhere & strOp & "(Unit_ID = """ & Me.ABCServiceDDL.Value & """)"
strOp = " And "
End If
If Len(strWhere) > 0 then
strSQL = strSQL & " WHERE " & strWhere
End If
strSQL = strSQL & " ORDER BY 6 asc"
Me.output1.RowSource = strSQL
End Sub
This is wordier, but much closer to correct. P.S. I guessed that all values are strings. If not remove the quoting around non-string values.
Can anyone help me with the below code to edit the records please?Im trying to edit but there is a Syntax error and I cant fix that.
See the error that appears below.
Run Time Error '3075'
Syntax Error(missing operator) in query expresion 'TypeID='.
Thanks
Private Sub oshaadd_Click()
'On Error Resume Next
If (IsNull(Me.oshaID) Or (Me.oshaID = "") And IsNull(Me.oshatype) Or (Me.oshatype = "")) Then
MsgBox "please fill required fields!", vbInformation, "Information"
Exit Sub
End If
If Me.oshaID.Tag & "" = "" Then
CurrentDb.Execute "INSERT INTO osha(TypeID, OSHA)" & _
"VALUES ('" & Me.oshaID & "', '" & Me.oshatype & "')"
If MsgBox("Added", vbOKOnly) Then
Me.osha_subform.Form.Requery
End If
Else
CurrentDb.Execute "UPDATE osha " & _
"SET TypeID =" & Me.oshaID & _
", OSHA = '" & Me.oshatype & "'" & _
"WHERE TypeID =" & Me.oshatype.Tag
MsgBox "Updated", vbInformation, "Information"
Me.oshaadd.Caption = "Add"
Me.oshaedit.Enabled = True
End If
Me.osha_subform.Form.Requery
End Sub
Private Sub oshaedit_Click()
On Error Resume Next
If Not (Me.osha_subform.Form.Recordset.EOF And Me.osha_subform.Form.Recordset.BOF) Then
With Me.osha_subform.Form.Recordset
Me.oshaID = .Fields("TypeID")
Me.oshatype = .Fields("OSHA")
Me.oshaID.Tag = .Fields("TypeID")
Me.oshaadd.Caption = "Update"
Me.oshaedit.Enabled = False
End With
End If
End Sub
You forget to put the database single quote around Me.oshaID and Me.oshatype.Tag in the UPDATE SQL statement:
CurrentDb.Execute "UPDATE osha " & _
"SET TypeID ='" & Me.oshaID & "'" & _
", OSHA = '" & Me.oshatype & "'" & _
" WHERE TypeID ='" & Me.oshatype.Tag &"';"
CurrentDb.Execute "UPDATE osha " & _
"SET TypeID =" & Me.oshaID & _
", OSHA = '" & Me.oshatype & "'" & _
"WHERE TypeID =" & Me.oshatype.Tag
MsgBox "Updated", vbInformation, "Information"
Me.oshaadd.Caption = "Add"
Me.oshaedit.Enabled = True
In this block of your code where you have "SET TypeID =" and "WHERE TypeID =" try adding a space after the equals sign so it reads "TypeID = ". If that doesn't resolve the error try adding single quotes around the value you are assigning to TypeID (TypeID = '" & Me.oshaID & _"',)
I'm running Visual studio and whenever I run my application it says "Incorrect syntax error near '(the email i enter appears here)'". I hope you can spot the mistake.
Within SQL server, my email column is called 'email'
Within Visual studio, the name of the input field for my email is called 'textEmail'
Public Sub AddCustomer(Firstname As String, Surname As String, Contactnum As String, Email As String)
Try
Dim strInsert As String = "INSERT INTO customers (firstname, surname, contactnum, email) " & _
"VALUES (" & _
"'" & Firstname & "'," & _
"'" & Surname & "'," & _
"'" & Contactnum & "'," & _
"'" & Email & "'"
MsgBox(strInsert)
SQLCon.Open()
SQLcmd = New SqlCommand(strInsert, SQLCon)
SQLcmd.ExecuteNonQuery()
SQLCon.Close()
Catch ex As Exception
MsgBox(ex.Message)
End Try
End Sub
End Class
Code within form:
Private Sub cmdSave_Click(sender As Object, e As EventArgs) Handles cmdSave.Click
'QUERY FOR CUSTOMER
SQL.RunQuery("SELECT * FROM customers WHERE customers.email = '" & txtEmail.Text & "' ")
If SQL.SQLDS.Tables(0).Rows.Count > 0 Then
MsgBox("This Email alredy exists!")
Exit Sub
Else
CreateCustomer()
End If
End Sub
Public Sub CreateCustomer()
' ADD CUSTOMER TO DATABASE
SQL.AddCustomer(txtFirst.Text, txtSur.Text, txtNum.Text, txtEmail.Text)
End Sub
End Class
Thanks for your time.
You are missing closing bracket
Dim strInsert As String = "INSERT INTO customers (firstname, surname, contactnum, email) " & _
"VALUES (" & _
"'" & Firstname & "'," & _
"'" & Surname & "'," & _
"'" & Contactnum & "'," & _
"'" & Email & "')"
I have a form contains "DateProduced" field. The table bound to it is called "Report".
I try to add after update event to this field and want this event to update "DateProduced" field in Quantity table if ID matches for both.
Me![Text0] displays the ID from Report field
Me![Text4] displays the DateProduced from Report field.
The event code is as below.
Private Sub Text4_AfterUpdate()
Dim strSQL As String
strSQL = "UPDATE Quantity " _
& "SET [DateProduced] = (#" & Me![Text4] & "#) " _
& "WHERE ID = (" & Me![Text0] & ")"
DoCmd.RunSQL strSQL
End Sub
But i can not succeed.
That date format will fail for values where dd/mm can be interchanged for a valid date. It should read:
Private Sub Text4_Exit(Cancel As Integer)
Dim strSQL As String
strSQL = "UPDATE Quantity " _
& "SET [DateProduced] = #" & Format(Me!Text4.Value, "yyyy\/mm\/dd") & "# " _
& "WHERE [ID] = " & Me![Text0].Value & ";"
DoCmd.RunSQL strSQL
End Sub
A note: You should change the names of Text0 etc. to meaningful names.
I made it work with the following code. Thx
Private Sub Text4_Exit(Cancel As Integer)
Dim strSQL As String
strSQL = "UPDATE Quantity " _
& "SET [DateProduced] = #" & Format(Me.Text4.Value, "dd-mm-yyyy") & "#" _
& "WHERE [ID] = (" & Me![Text0] & ");"
DoCmd.RunSQL strSQL
End Sub