Inaccuracies using TextWidth() in VBA - ms-access

I'm trying to get the length of a string in order to format a report using VBA in Access 2000. Yes I know this old but it's what I've been asked to do. I want to get the width of the string when printed; exactly what TextWidth() is meant to return. What I'm finding is that for strings ranging for 4-20 characters the returned value can range from exactly the right length to the correct length plus about an inch. This is too inaccurate for the formatting I wish to do. Is this common? I can't find any reference to this as a common problem but I've gone over and over the code and I'm fairly certain the function is just inaccurate ratehr than there being a logic problem.

Check the report's FontName and FontSize properties. If they are different than the field you are working with, you'll get wildly different results.
Private Sub Detail_Format(Cancel As Integer, FormatCount As Integer)
MsgBox (Me.FontName & " ," & Me.FontSize)
MsgBox (TextWidth("Test"))
Me.FontName = Me.f2.FontName 'ariel
Me.FontSize = Me.f2.FontSize '8
MsgBox (Me.FontName & " ," & Me.FontSize)
MsgBox (TextWidth("Test"))
Me.FontName = Me.f1.FontName 'ariel
Me.FontSize = Me.f1.FontSize '16
MsgBox (Me.FontName & " ," & Me.FontSize)
MsgBox (TextWidth("Test"))
End Sub
I'm still not sure how to set the report's font name and size though, I don't see anything in it's properties.

Related

Output specific values from a textbox to multiple textboxes in VB

I am using VB with VS2015, and I have a textbox which receives about 40 lines of input from a microprocessor. What I ultimately need to do is display some of the input in multiple textboxes, as well as save those values into a mySQL database. For example, let's say I have:
SensorTypeA_Test
SensorA1_Output: 5.00
SensorA2_Output: 0
SensorA_Test: FAIL
SensorTypeB_Test
SensorB1_Output: 3.50
SensorB2_Output: 3.50
Sensor_Test: Pass
In this case, what I would like to do is basically have 6 textboxes (each with a pre-made label such as Sensor A1) fill with 5.00, 0, FAIL, 3.50, 3.50 and Pass.
As I see it, there are two ways to approach this. First, I could just figure out how to send the values straight to the mySQL database and then pull the needed values into the multiple textboxes. This would be fairly straight forward, but I don't know of a way to send these values directly to the database since they don't have variable names.
The other way is to either parse through the textbox itself or save the input to a file and parse through that. If I did it this way, I would prefer to have each textbox look for the value corresponding to its label, as opposed to filling all of the text boxes sequentially. What I mean by that is if there is a textbox labeled "Sensor A1", it would have its own variable name, say tbSensorA1 and it would look for "SensorA1_Output" and then show the value that comes after the colon, and if there is no value, then just display "N/A" in the textbox. This would also make it really easy to store the values in the database.
So basically, I'm wondering if there are any other ways to do this besides what I proposed, and if not, how can I search a textbox or a text file for a specific phrase and output the values which follow the colon in their corresponding textboxes? Any help is appreciated! Thanks!
Well - lots of ways to do this. I wouldn't recommend trying to do this in the database as databases are not great for parsing, and this feels like logic you should have in your middle or front end anyway. It might be totally front end if this is just really a way to display data you already have.
Here is one approach - create your text boxes that you desire, and in each text boxe's tag property - store a "Prefix" value that can be used to identify if a given sensor data value is appropriate for that text box.
Then you simply loop through each of the text boxes, and sensor data lines, do the comparison, then add the value to the text box if its a match.
Here is sample code:
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
txtSensor.Text = "SensorTypeA_Test()" & vbCrLf & _
"SensorA1_Output: 5.00" & vbCrLf & _
"SensorA2_Output: 0" & vbCrLf & _
"SensorA_Test: FAIL()" & vbCrLf & _
"SensorTypeB_Test()" & vbCrLf & _
"SensorB1_Output: 3.50" & vbCrLf & _
"SensorB2_Output: 3.50" & vbCrLf & _
"Sensor_Test: Pass()"
End Sub
Private Sub btnPopulate_Click(sender As Object, e As EventArgs) Handles btnPopulate.Click
txtSensorA.Tag = "SensorA"
txtSensorB.Tag = "SensorB"
Dim lstOutputs As New List(Of TextBox)
lstOutputs.Add(txtSensorA)
lstOutputs.Add(txtSensorB)
Dim sensorData() As String = txtSensor.Text.Trim.Split(vbCrLf)
For Each tb In lstOutputs
For Each sline In sensorData
If sline.TrimStart.StartsWith(tb.Tag) Then
UpdateOutputTextBox(tb, sline.Trim)
End If
Next
Next
End Sub
Private Sub UpdateOutputTextBox(tb As TextBox, sLine As String)
Dim sParts() As String = sLine.Split(":")
Dim sData As String = String.Empty
If sParts.Count = 2 Then
sData = sParts(1)
If tb.Text.Length > 0 Then
tb.Text &= (", " & sData.Trim)
Else
tb.Text = sData.Trim
End If
End If
End Sub
And the result...
So you should be able to do something very similar. Hope this helps.

Run Time Error 424 Object Required

I been working on the following code to when the user click on the button to save and go new record that Access locates the highest client id used by set location and then adds 1 to it. Prior to saving the record and moving on to new record. While work through other errors, but I can not get past error object required on this line. "Me.ClientID = IIf(DMax("[ClientID]", "tClientinfo", "[CorpsName]=" & "'defaultcorps'") Is Null, 0, DMax("[ClientID]", "tClientinfo", "[CorpsName]=" & "'defaultcorps'")) + 1"
The more i look at the similar questions more confused I get as to what is wrong with the code. Thank you in advance for any suggestions David
Private Sub Save_Record_Click()
'declare variables for default values
Dim defaultinterviewr As String
Dim defaultcorps As String
'Variables get their values
defaultinterviewr = Me.Interviewer.Value
defaultcorps = Me.Corps.Value
'Check to see if ClientID field is Blank.
If IsNull(Me.ClientID) Then
'Check that Corps field is filled in
If IsNull(Me.Corps) Then
MsgBox "Corps must be entered before saving record.", vbOKOnly
Me.Corps.SetFocus
'set client id base on corps by finding the highest id and adding 1 to that number
Else
Me.ClientID = IIf(DMax("[ClientID]", "tClientinfo", "[CorpsName]=" & "'defaultcorps'") Is Null, 0, DMax("[ClientID]", "tClientinfo", "[CorpsName]=" & "'defaultcorps'")) + 1
End If
End If
MsgBox "Done", vbOKOnly
'save record
'DoCmd.RunCommand acCmdSaveRecord
'Me.stateidnum1 = ""
'open new record
'DoCmd.GoToRecord , , acNewRec
'set field default value
'Me.Interviewer.Value = defaultinterviewr
'Me.Corps.Value = defaultcorps
'Me.Child_Subform.Form.AllowAdditions = True
End Sub
I think you need to start off by figuring out if your DMAX() statement is correctly producing results. The next thing I see and which is probably your main culprit is the fact that you are using the Expression IIf() inside VBA. The IIf() expression you are using will work inside a query or in a textbox but VBA has it's own If statement block which you are correctly using in the lines preceding it.
I would actually use the Nz Function to simplify it even more as follows:
UPDATED Based off of your comment below I re-looked at your overall code and noticed that "defaultcorps" is a variable and not a value I originally thought you were trying to filter by. You were wrapping the variable in quotes. My updated answer should work for you.
Me.ClientID = (Nz(DMax("[ClientID]", "tClientinfo", "[CorpsName]= '" & defaultcorps & "'"),0)+1)

how to write a script to look for and correct invalid entries in a table

First off I'd like to make perfectly clear that my knowledge of Access and VBA is extremely limited at best. I have an employee database system that due to it's age has been prone to small data corruption issues and controls breaking due to differences between 2003/2007 and 2010. While I've managed to hash out the bulk of the problems, one that has me especially concered is the script we're using to manage access to the database. The system is split between two files, a frontend where users can access the database and a backend file that contains all of the tables.
The issue I have is in the frontend form that handles the logon for the users. The way the access system is set up is the user enters their SSN, then the script finds their SSN in the table and if it exists looks if an access checkbox is checked. If they have access, they're directed to the main menu, if not they get a denied message. What I've found though is for some reason or another, if an entry in the personnel table has an incomplete SSN, the script breaks and anyone can gain access to the database.
There's a query that runs in the frontend that looks at the master personnel table and pulls just the first two columns, SSAN and Access.
The form itself has a visible text box, "Text8", and a hidden Combo Box "Combo4". Combo4 uses the previously mentioned query for the row source (SELECT qryAccess.SSAN FROM qryAccess;), while Text8 is where the user enters their SSN.
Here's the code right now:
Option Compare Database
Private Sub Combo4_AfterUpdate()
' Find the record that matches the control.
Dim rs As Object
Set rs = Me.Recordset.Clone
rs.FindFirst "[SSAN] = '" & Me![Combo4] & "'"
If Not rs.EOF Then Me.Bookmark = rs.Bookmark
If Me![Access] = True Then
DoCmd.RunMacro "Access"
Else
DoCmd.OpenForm "frmDenied"
End If
End Sub
Private Sub Text8_AfterUpdate()
Me![Combo4] = Me![Text8]
' Find the record that matches the control.
Dim rs As Object
Set rs = Me.Recordset.Clone
rs.FindFirst "[SSAN] = '" & Me![Combo4] & "'"
If Not rs.EOF Then Me.Bookmark = rs.Bookmark
If Me![Access] = True Then
DoCmd.RunMacro "Access"
Else
DoCmd.OpenForm "frmDenied"
End If
End Sub
Like I said before, as long as every entry for the SSNs is a full 9-digits, this system works. However, if for some reason the entry is not the full 9 like I just found in my database (and no, I have no idea what caused that to happen, there is an input mask in place, 000-00-0000;;_), this system breaks. You could type in "abc" for the SSN and gain access to the database.
How can I write a small script that pre-checks the table for SSN entries that don't fit the 9-digit format that is set, and if it finds them, resets them to an unused number, such as 000000000, 000000001, etc?
Also, if you have any suggestions on how to streamline the existing code, I'd be more than happy to take them.
Add this function to you application
Public Function IsValidSSN(ByVal SSN As String) As Boolean
'Determines if SSN is a valid social security number
'requires SSN to be in either "#########" or "###-##-####" format
IsValidSSN = (SSN Like "###-##-####") Or _
SSN Like ("#########")
End Function
Also change your function to this:
Private Sub Combo4_AfterUpdate()
' Find the record that matches the control.
If IsValidSSN(Me![Combo4]) Then
Dim rs As Object
Set rs = Me.Recordset.Clone
rs.FindFirst "[SSAN] = '" & Me![Combo4] & "'"
If Not rs.EOF Then Me.Bookmark = rs.Bookmark
If Me![Access] = True Then
DoCmd.RunMacro "Access"
Else
DoCmd.OpenForm "frmDenied"
End If
Else
DoCmd.OpenForm "frmDenied"
End IF
End Sub
Private Sub Text8_AfterUpdate()
Me![Combo4] = Me![Text8]
If IsValidSSN(Me![Text8]) Then
' Find the record that matches the control.
Dim rs As Object
Set rs = Me.Recordset.Clone
rs.FindFirst "[SSAN] = '" & Me![Combo4] & "'"
If Not rs.EOF Then Me.Bookmark = rs.Bookmark
If Me![Access] = True Then
DoCmd.RunMacro "Access"
Else
DoCmd.OpenForm "frmDenied"
End If
Else
DoCmd.OpenForm "frmDenied"
End If
End Sub
EDIT
Also why are you using a combobox to enter a SSN? You can use input mask on text box. Also I would highly suggest that you convert your system to some other identification other than SSN because it is easily passable to get past this code to look at the table containing everyones SSN, by holding down shift when opening the application. As for streamlining your code just remove that combobox altogether. If they are typing it into a textbox there is no need to put it into a hidden combobox.
You have a text field, SSAN, and with that input mask the dashes are not included in the stored values. So valid values would be 9 digit strings.
If that is correct, you can use a query to identify any invalid stored values.
SELECT y.SSAN, Len(SSAN) AS LenghtOfSSAN
FROM YourTable AS y
WHERE Len(SSAN)<>9 OR y.SSAN ALike '%[!0-9]%';
That query will return rows where SSAN includes < or > 9 characters, and any values which include characters other than digits.
Note the ALike keyword tells the db engine to expect ANSI wild card characters.  If you prefer Access' * wild card instead, change it to Like '*[!0-9]*'
Once you fix the stored values, add a Validation rule for that SSAN field (Like "#########") to require all values consist of 9 digits.
Since it looks like this became more of a "How do I find the user" than "How do I fix the existing entries", let me throw my hat into the ring.
Unless I completely misunderstand this, the existing (and accepted answer) function is HORRIBLE. You can do this all much more efficiently and with less code. First of all, delete Combo4. No need for it. Then do this:
Private Sub Text8_AfterUpdate()
Dim X as Integer
X = DLookup("Access", "qryAccess", "SSAN = '" & Me!Text8 & "'")
If Nz(X) = True Then
DoCmd.RunMacro "Access"
Else
DoCmd.OpenForm "frmDenied"
End If
End Sub
That's all you need. If the user's SSN was stored incorrectly, he's gonna be denied. 7 digits, 8 digits, doesn't make a difference. Only exact matches get through. That is, assuming 0 = False and 1 = True, which should be the default anyway.

Filter in Access form

I have a form and I want it to be filtered just after it loads.
After I click on the form it should be able to load by filtering specific data.
I want it to filter by Program Nam and Year.
I have tried the following code but I keep getting syntax errors:
Private Sub Form_Load()
Combo5.Value = Form_0_Cover.Combo0
Combo7.Value = Form_0_Cover.Combo2
'Me.Filter = "[Program_Name]=" & Me.Combo7 & " AND [Budget_Year]='" & Me.Combo5 & ""
End Sub
I am not sure what the problem seems to be. I keep getting syntax error.
Try:
Me.Filter = "[Program_Name]='" & Me.Combo7 & "' AND [Budget_Year]=" & Me.Combo5
I suspect that program name is text and budget year is numeric. It is possible that the program name combo has an id as the bound column, in which case things might get a little more difficult, probably:
Me.Filter = "[Program_ID]=" & Me.Combo7 & " AND [Budget_Year]=" & Me.Combo5

Checking if record exists using DLookup (With Multiple Criteria)

Im trying to create a function in my VBA where if the record they are trying to insert already exists however it returns a type mismatch.
EventCombo is a integer
MedalCombo is string
Private Sub MyCombo_BeforeUpdate(Cancel As Integer)
If Not IsNull(DLookup("RacerID", "Medals", "RaceID = " + EventCombo.Value _
+ " AND Medal = '" + MedalCombo.Value + "'" )) Then
MsgBox "Record Exists"
End If.
End Sub
What this does (or is supposed to do) is make sure no one else has the same medal in the same race.
What am I doing wrong?
With combo boxes in Access, you need to make sure that .value is really what you want. Often the first column is hidden which is .value while what is visible on the drop down box is not .value. When using a combo box to eliminate confusion I use the .columns property.
Also, to make sure the result from the combo box is a number and not text (as you did not use quotes in your example) I used the val() function to convert the combobox data to a number. If it already is a number, this will have no effect. Otherwise, if it is a digit stored as a string, it will convert it to a number. This might not be strictly necessary but it eliminates another possible problem. If the combobox column has a value which is some text which cannot convert to a number it will return 0 which you can test for in your code.
I cleaned up your code a bit with the following
I replaced the + with & like Remou said
changed .value to .columns(0). If the column you are looking for is not the first one, change 0 to the appropriate value
value() function
removed line continuation _. (Personal preference, feel free to ignore)
Private Sub MyCombo_BeforeUpdate(Cancel As Integer)
If Not IsNull(DLookup("RacerID", "Medals", "RaceID = " & Val(EventCombo.Columns(0)) & " AND Medal = '" & MedalCombo.Columns(0) & "'")) Then
MsgBox "Record Exists"
End If
End Sub