I´m saving a date in a table like this:
Me!lastchangedate.Caption = Now
Set db = CurrentDb
Set rs = db.OpenRecordset("background", dbOpenTable)
rs.AddNew
rs![date] = Me!lastchangedate.Caption
rs.Update
rs.Close
Later I want to read this date out of the database and show it in a Label:
sqlstrdate = "SELECT date FROM background " _
& " WHERE SAP_ID = '" _
& Me!sapidtxt.Value & "'"
retvaldate = CurrentDb.OpenRecordset(sqlstrdate)
Until here it´s working but if I now try to show "retvaldate" as MsgBox or in a label I always get the error message: Error 13 type mismatch.
Im trying to use this to show the saved date in a label.
Me!lastchangedate.Caption = (retvaldate)
Is there an option to change the label type or do I have to change the "retvaldate" to a date type (which also gives me the same error).
You are trying to set 'retvaldate' like opening a recordset. The following should provide the correct result (BTW, why do you use reserved words like 'date' as a field name?)
Dim rs As Recordset
Dim sqlstrdate As String
sqlstrdate = "SELECT date FROM background " _
& " WHERE SAP_ID = '" _
& Me!sapidtxt.Value & "'"
Set rs = CurrentDb.OpenRecordset(sqlstrdate)
If Not rs.EOF Then
retvaldate = rs.Fields("Date")
Else
retvaldate = "No Records"
End If
rs.Close
Set rs = Nothing
'Then later... but I hope the variable is in scope (Global, form, subroutine)
Me!lastchangedate.Caption = retvaldate
Related
I have a database where i can add a full name of a person, and i am trying to implement a search function using a textBox and a button but i only want to search for the first or last name not necessarily entering the full name.
I tried using SELECT FROM WHERE CONTAINS like this:
OleDbCommand cmd = con.CreateCommand();
cmd.CommandType = CommandType.Text;
cmd.CommandText = "SELECT * FROM Table WHERE CONTAINS (column, '"+textBox.Text+"')";
But i keep getting this error:
Syntax error (missing operator) in query expression 'CONTAINS (column,'the text i tried to search')'.
I also tried changing the + to % or * or & but still it didn’t work.
Contains is not valid Access SQL. Use Like:
cmd.CommandText = "SELECT * FROM Table WHERE [YourNameField] Like '*" + textBox.Text + "*')";
Here is an example of a search such as you want:
Private Sub cmdFind_DisplayName_Click()
Dim dbs As Database, rstPatient As Recordset
Dim txtDisplayName, strQuote As String
strQuote = Chr$(34)
On Error GoTo ErrorHandler
Me.OrderBy = "DISPLAYNAME"
Me.OrderByOn = True
Set dbs = CurrentDb
Set rstPatient = Me.RecordsetClone
txtDisplayName = Trim(InputBox("Please Enter Patient Name ", "Patient Find By Name"))
txtDisplayName = UCase(txtDisplayName) & "*"
If IsNull(txtDisplayName) Then
MsgBox ("No Patient Name Entered - Please Enter a Valid Patient Name")
Else
rstPatient.FindFirst "[DISPLAYNAME] Like " & strQuote & txtDisplayName & strQuote
If Not (rstPatient.NoMatch) Then
Me.Bookmark = rstPatient.Bookmark
Me.Refresh
Else
MsgBox ("Patient Not Found - Please Enter a New Patient Name")
End If
End If
GoTo Exit_cmdFind_Click
ErrorHandler:
MsgBox LTrim(RTrim(Me.NAME)) + "." + "Patient Find By Display Name - " + "Error: " + AccessError(Err.Number)
Exit_cmdFind_Click:
rstPatient.Close
Set dbs = Nothing
Set rstPatient = Nothing
End Sub
Create 1 textbox (txtMain) and search command button(btnSearch) to execute SQL. Then add a listbox (listResult) to display results.
Private Sub btnSearch_Click()
Dim mainSQL As String
mainSQL = " SELECT YOUR_FIELD_NAME " & _
" FROM MasterReg " & _
" WHERE Left(,InStr(YOUR_FULL_NAME_FIELD,' ')-1) LIKE '" & me.txtMain & "*'" & _ ' Firstname Search
" OR RIGHT( YOUR_FULL_NAME_FIELD,Len( YOUR_FULL_NAME_FIELD )-InStr( YOUR_FULL_NAME_FIELD,' ')) LIKE '" & me.txtMain & "*'" 'Surname Search
Me.listResult.SetFocus
Me.listResult.RowSource = mainSQL
Me.listResult.Requery
End Sub
I have data from a query name "GrabInfoOfMostRecent" and I am using it as a source for Word to fill in a document with bookmarks. However, once I get to any non-text data, I get error 438 "Object doesn't support this property or method".
Specifically:
For "MRN"I have tried all variations of .Range.Text/Value/Value2 and cannot get the number MRN to fill into the appropriate Bookmark.
For "Diagnosis1", I get an Error13 "Type Mismatch" but I don't know why. It is defined as "Short Text" just as all previous text entries are.
Anyone with any help, I would be deeply appreciative.
Sub WordAutomation()
On Error GoTo HandleError
' Object variables for Automation stuff
' declare them like so during development
' you need to set a reference to the applications
'Dim objWord As New Word.Application
' declare them like this when development is complete
' references no longer necessary
Dim objWord As Object
' Object variables for database access
Dim db As DAO.Database
Dim rstPatientVisit As DAO.Recordset
Dim rsReportData As DAO.Recordset
Dim rsExclusions As DAO.Recordset
' Scalar variables
Dim strsql As String
Dim strFile As String
Dim conPath As String
Dim wdGoToBookmark As Integer
'find the folder where the database resides
Set db = CurrentDb
Set rsReportData = db.OpenRecordset("GrabInfoOfMostRecent")
strFile = db.Name
conPath = Mid(strFile, 1, Len(strFile) - Len(Dir(strFile)))
'Step through the records one at a time, creating a Word
'document for each.
'Do While Not rsReportData.EOF
'--create new word document
Set objWord = CreateObject("Word.Application")
objWord.Documents.Add conPath & "TunTemplate.dotx"
' Make both Word and the document are visible
objWord.Visible = True
objWord.Windows(1).Visible = True
'find bookmarks and insert values
With objWord.ActiveDocument.Bookmarks
.Item("RDFirst").Range.Text = rsReportData!RDFirstName
.Item("RDLast").Range.Text = rsReportData!RDLastName
.Item("PFirstName").Range.Text = rsReportData!PVFirstName
.Item("PLastName").Range.Text = rsReportData!PVLastName
.Item("MRN").Range.Value2 = rsReportData!MRN
.Item("RDAddress").Range.Text = rsReportData!RDAddress
.Item("PAddress").Range.Text = rsReportData!Address
.Item("RDCity").Range.Text = rsReportData!RDCity
.Item("RDCounty").Range.Text = rsReportData!RDCounty
.Item("PCity").Range.Text = rsReportData!City
.Item("PCounty").Range.Text = rsReportData!County
.Item("RDPostalCode").Range.Text = rsReportData!RDPostalCode
.Item("PPostalCode").Range.Text = rsReportData!PostalCode
.Item("Diagnosis1").Range.Text = rsReportData!Diagnosis1
.Item("Treatment1").Range.Text = rsReportData!Treatment1
.Item("Changes1").Range.Text = rsReportData!Changes1
.Item("Diagnosis2").Range.Text = rsReportData!Diagnosis2
.Item("Treatment2").Range.Text = rsReportData!Treatment2
.Item("Changes2").Range.Text = rsReportData!Changes2
.Item("Diagnosis3").Range.Text = rsReportData!Diagnosis3
.Item("Treatment3").Range.Text = rsReportData!Treatment3
.Item("Changes3").Range.Text = rsReportData!Changes3
.Item("Diagnosis4").Range.Text = rsReportData!Diagnosis4
.Item("Treatment4").Range.Text = rsReportData!Treatment4
.Item("Changes4").Range.Text = rsReportData!Changes4
.Item("Diagnosis5").Range.Text = rsReportData!Diagnosis5
.Item("Treatment5").Range.Text = rsReportData!Treatment5
.Item("Changes5").Range.Text = rsReportData!Changes5
.Item("Weight").Range.Text = rsReportData!Weight
.Item("Height").Range.Text = rsReportData!Height
.Item("BMICalc").Range.Text = rsReportData!BMICalc
.Item("Waist").Range.Text = rsReportData!Waist
.Item("BP").Range.Text = rsReportData!BP
.Item("RAcuity").Range.Text = rsReportData!REyeAcuity
.Item("LAcuity").Range.Text = rsReportData!LEyeAcuity
.Item("RRetina").Range.Text = rsReportData!RLensRetina
.Item("LRetina").Range.Text = rsReportData!LLensRetina
.Item("HbA1c").Range.Text = rsReportData!HbA1C
.Item("Creatinine").Range.Text = rsReportData!Creatinine
.Item("TChol").Range.Text = rsReportData!TChol
.Item("UrineACR").Range.Text = rsReportData!UrineACR
.Item("LDL").Range.Text = rsReportData!LDL
.Item("TSH").Range.Text = rsReportData!TSH
.Item("HDL").Range.Text = rsReportData!HDL
.Item("B12").Range.Text = rsReportData!B12
.Item("TG").Range.Text = rsReportData!TG
.Item("EGFR").Range.Text = rsReportData!EGFR
End With
'find and write exclusion data
strsql = "SELECT ReportID, Exclusion " & _
"FROM ExclusionData " & _
"WHERE ReportID=" & rsReportData!ReportID
Set rsExclusions = db.OpenRecordset(strsql)
Do While Not rsExclusions.EOF
With objWord.ActiveDocument.Bookmarks
.Item("exclusions").Range.Text = rsExclusions!Exclusion & vbCrLf
rsExclusions.MoveNext
End With
Loop
rsExclusions.Close
'Save the document and close Word
objWord.ActiveDocument.SaveAs (conPath & rsReportData!MRN & ".doc")
'objWord.Quit
'go to next record for processing
'rsReportData.MoveNext
'Loop
'Tell the user the process is done.
MsgBox "Done!" & vbCrLf & vbCrLf & _
"Look in this directory" & vbCrLf & conPath & vbCrLf & _
"for your documents."
ProcDone:
' clean up our object variables
Set objWord = Nothing
Set rsReportData = Nothing
Set rsExclusions = Nothing
Set db = Nothing
ExitHere:
Exit Sub
HandleError:
'display appropriate error message
Select Case Err.Number
Case 5151 'Word template not found
'Close stranded applications
MsgBox "Word template not found"
Case 5152 'Invalid file name
'Close stranded applications
objWord.ActiveDocument.Close SaveChanges:=False
objWord.Quit
MsgBox "This file or folder does not exist"
Case Else
MsgBox Err.Description, vbExclamation, _
"Error " & Err.Number
End Select
Resume ProcDone
End Sub
Simply with the desire to help you troubleshoot this; I offer the following.
Try converting the problem field into a string using:
.Item("Diagnosis1").Range.Text = CStr(rsReportData!Diagnosis1)
You may also want to display a dialog box with the contents of rsReportData!Diagnosis1:
MsgBox "rsReportData!Diagnosis1 is: " & rsReportData!Diagnosis1 _
, vbOkOnly + vbInformation
To convert null values into zero-length-strings, you can use the following:
.Item("Diagnosis1").Range.Text= IIf(IsNull(rsReportData!Diagnosis1), "", rsReportData!Diagnosis1)
I have the following VBA code in my access.
Dim subform As Object
Dim formFilter As String
formFilter = "..." 'a SQL statement
Set subform = Me!my_subform.Form
subform.RecordSource = formFilter
subform.field1.ControlSource = "f1"
subform.field2.ControlSource = "f2"
subform.field3.ControlSource = "f3"
Dim db As Database
Dim rs As Recordset
Set db = CurrentDb
Set rs = db.OpenRecordset("SELECT TOP 1 f4 FROM my_table " _
& "WHERE tableF1= '" & [f1] & "' AND tableF2 = '" & [f2] & "' " _
& "ORDER BY tableF5 DESC")
subform.field4.ControlSource = rs(0)
I have first bound my first 3 fields in subform to the fields of my record source. Then I need to bind the 4th field to a different recordset. This recordset has to refer to the first 2 fields of my subform.
However, I got a run-time error 2465. Access is not able to refer to the field [f1] and [f2] of my OpenRecordSet statement.
How should I fix this?
I use this form in a datasheet view. So I need to refer to not a single value of field1 and field2, but the entire columns of records have to be linked.
Thanks a lot.
(from an earlier edit to the question, since rolled back:)
Apparently the solution in this case was to use the following code in the On Load event handler for the subform instead of the main form
Dim db As Database
Dim rs As Recordset
Set db = CurrentDb
Set rs = db.OpenRecordset("SELECT TOP 1 f4 FROM my_table " _
& "WHERE tableF1= '" & [f1] & "' AND tableF2 = '" & [f2] & "' " _
& "ORDER BY tableF5 DESC")
subform.field4.ControlSource = rs(0)
because the [f1] and [f2] controls were on the subform and therefore not visible from the Class Module code for the main form.
Copy from: https://softwareengineering.stackexchange.com/questions/158330/cascading-comboboxes
ok so i have a form, in Access 2010, with 1 Textbox and 3 ComboBoxes (1 Enabled & 2 Disabled).
the first ComboBox is not tied to the datasource but is subjective to the other 2 comboboxes. So i handled the Click event for the first Combobox to then make the other 2 enabled, and preload the 2nd ComboBox with a custom RowSource SQL Script dynamically built based on the 1st ComboBox Value.
This all works great for New information but when i goto review the information, via Form, its back to the New mode on the controls.
Question:
What event do i need to handle to check if the current Form Data contains data for the Control Source of the Controls?
As i would express it in Logic (its a mix between C & VB, i know but should get the pt acrossed):
DataSet ds = Form.RowSet
if (ds = Null) then
cbo2.enabled = false
cbo3.enabled = false
else
cbo2.rowsource = "select id, nm from table"
cbo2.value = ds(3)
cbo3.value = ds(4)
end if
... do some other logic ...
Updated Logic - Still problem, cant catch for RecordStatus for some reason (gives 3251 Run-Time Error)
Private Sub Form_Current()
Dim boolnm As Boolean: boolnm = (IsNull(txtName.Value) Or IsEmpty(txtName.Value))
Dim booltype As Boolean: booltype = IsNull(cboType.Value)
Dim boolfamily As Boolean: boolfamily = IsNull(cboType.Value)
Dim boolsize As Boolean: boolsize = IsNull(cboType.Value)
Dim rs As DAO.Recordset: Set rs = Me.Recordset
MsgBox rs.AbsolutePosition
' If rs.RecordStatus = dbRecordNew Then
' MsgBox "New Record being inserted, but not committed yet!", vbOKOnly
' Else
' MsgBox rs(0).Name & " - " & rs(0).Value & vbCrLf & _
' rs(1).Name & " - " & rs(1).Value & vbCrLf & _
' rs(2).Name & " - " & rs(2).Value & vbCrLf & _
' rs(3).Name & " - " & rs(3).Value
' End If
'MsgBox "Name: " & CStr(boolnm) & vbCrLf & _
"Type: " & CStr(booltype) & vbCrLf & _
"Family: " & CStr(boolfamily) & vbCrLf & _
"Size: " & CStr(boolsize), vbOKOnly
End Sub
Here is the final result, with Remou's assistance, and this is only a precursor to the end result (which is out of the context of the question).
Private Sub Form_Current()
If Me.NewRecord Then <=======================
cboType.Value = 0
cboType.Enabled = True
cboFamily.Enabled = False
cboSize.Enabled = False
Else
Dim rs As DAO.Recordset: Set rs = Me.Recordset
'get Family ID
Dim fid As String: fid = rs(2).Value
'Build SQL Query to obtain Type ID
Dim sql As String
sql = "select tid from tblFamily where id = " & fid
'Create Recordset
Dim frs As DAO.Recordset
'Load SQL Script and Execute to obtain Type ID
Set frs = CurrentDb.OpenRecordset(sql, dbOpenDynaset, dbReadOnly)
'Set Type ComboBox Value to Type ID
cboType.Value = frs(0)
cboType_Click 'Simulate Click Event since the Value has changed
'Make sure all 3 Comboboxes are enabled and useable
cboType.Enabled = True
End If
End Sub
I'm writing an Access database. I have a number of forms that are identical. These are used to edit look up lists for different fields in my main contacts table.
e.g. there is a company field and a country field. The forms that open for each editable list are identical with repeat vba code in each becasue I cannot work out how to reference the active table from the active form.
The code I currently have for clearing all the yes/no boxes in the table is:
Private Sub cmdClearTicks_Click()
Dim db As Database
' Dim sel As Control
Set db = CurrentDb
' Clear all ticks of selected records
db.Execute "UPDATE ContactCompany " _
& "SET Selected = null "
' Update Selected Field
Me.Requery
End Sub
ContactCompany is the name of the table. I would like to be able to set this sub globally but cannot work out what I should replace ContactCompany with to reference the table in the currently open form. I've already tried Me.RecordSource which does not work.
I'm very grateful for what I assume is a very easy fix!
Sean posted a great fix below. I'm now stumped with including a filter too and defining it globaly.
Sub SelectFiltered(RS As String)
Dim strFilter As String
Dim strSQl As String
If InStr(RS, "FROM") Then
RS = Mid(RS, InStr(RS, "FROM") + 5)
If InStr(RS, " ") Then RS = Left(RS, InStr(RS, " ") - 1)
End If
strFilter = Me.Filter
If Me.FilterOn = False Then
'Select Case MsgBox("No search or filter applied.", vbCritical + vbOKOnly, "Warning")
'End Select
strSQl = "UPDATE " & RS & " " & _
"SET Selected = 1 "
Else
strSQl = "UPDATE " & RS & " " & _
"SET Selected = 1 " & _
"WHERE " & strFilter
End If
DoCmd.SetWarnings False
DoCmd.RunSQL strSQl
DoCmd.SetWarnings True
End Sub
Me.filter doesn't work in the global sub. Sean - I'm sure you'll have an answer for this in a sec. Thanks again!
you are close with using Me.Recordsource
db.Execute "UPDATE " & Me.Recordsource & " SET Selected = null "
or, if you want it as a global function, pass Me.Recordsource to it
Sub ClearTicks(RS as string,StrFilter as string)
Dim db As Database
Set db = CurrentDb
If InStr(RS, "FROM") Then
RS = Mid(RS, InStr(RS, "FROM") + 5)
If InStr(RS, " ") Then RS = Left(RS, InStr(RS, " ") - 1)
End If
' Clear all ticks of selected records
db.Execute "UPDATE " & RS & " SET Selected = null "
If StrFilter="" then 'no filter
Else 'filter
End If
End Sub
and your calling function would be:
Private Sub cmdClearTicks_Click()
ClearTicks Me.Recordsource,Me.Filter
Me.Refresh
End Sub
If you want a more reusable function method that could be expanded more easily, then call the sub/function with Me.Name as the parameter (e.g. MySub Me.Name) and then in your reusable function:
sub MySub(FrmName as string)
Forms(FrmName).Filter
Forms(FrmName).Recordsource
Forms(FrmName).AnyOtherParamater