In my Access DB, I have set a VBA code that looks for a record that has a certain value in the field called FieldB. If the record is present, the variable Var takes the value of the field FieldA, otherwise a default value of 100.
The code I wrote is the following. The problem is that, when the record is not present, I get the error No current record at the command IsNull(VESRecordSet.Fields(0).Value). I suppose that there are some mistakes in this code and that it can be written in a better way.
sql = " SELECT * FROM TableA WHERE FieldB = 'current_value');"
Set VESRecordSet = CurrentDb.OpenRecordset(sql)
If IsNull(VESRecordSet.Fields(0).Value) Then
Var = VESRecordSet.Fields(0).Value
Else
Var = "100"
End If
You should use .EOF to detect if there's a record. That's true if the recordset is at the end of the file (there are no records left), and if it's at the end of the file when you've just opened it, it contains no records.
If Not VESRecordSet.EOF Then
Var = VESRecordSet.Fields(0).Value
Else
Var = "100"
End If
Related
I'm currently struggling how to set up validation rules for forms in either Datasheet or Form view that trigger immediately upon going to either another field within the record or to another record entirely.
My form is designed to add records to one destination table where the primary key column needs to match a value of a specific field in any record of a source table. The rest of the fields in the form (and destination table) are for general user input (some DateTime fields, some text, some decimal).
I can get Access to display a standard error dialogue when a user attempts to free-enter a value not on the list immediately after selection of another field or record. The error displayed is
The text you entered isn't an item in the list.
Select an item from the list, or enter text that matches one of the listed items"
And if I reselect a lookup value already selected and go to the next record, I get
The changes you requested to the table were not successful because they would create duplicate values in the index, primary key, or relationship. Change the data in the field or fields that contain duplicate data, remove the index, or redefine the index to permit duplicate entries and try again.
However, I'd like that error (or similar) to appear immediately if going to another field within the same record. In other words, I want it to tell me that it's a duplicate before allowing the user to fill out the rest of the current record in the form or table.
I would like the selection list be restricted to values not previously present in the destination table. Obviously if editing an already-created entry, you should be able to keep the value you had previously (i.e. that value wouldn't be excluded from the dropdown list).
Alternatively there would be a selection dialogue that would appear if an otherwise valid value was duplicated.
Duplicate Value
You've already used that value. Would you like to change this record or the previously-entered record.
⪡ This One ⪢ < Previous >
If "Previous" is selected, it would jump up to the same field in the indicated record, providing a dropdown list for re-selection (and once done would jump back to the "current" record and autoselect the temporarily duplicated value.
I'll edit this post in a bit with my table design details, as well as source setups for the form.
"Solved" this in VBA.
Private Sub MyControl_AfterUpdate()
newval = Me.MyControl.Value
oldval = Me.MyControl.OldValue
If newval = oldval Then Exit Sub ' everything's okay
Dim rs As Object
Set rs = Me.Form.Recordset
whereclause = "MyControl = '" & newval & "'"
qry = "SELECT COUNT(*) as c FROM MyQuery WHERE " & whereclause
qrs = CurrentDb.OpenRecordset(qry)
If qrs.Count = 1 Then cnt = qrs(0).Value
If cnt >= 1 Then
selval = MsgBox("Would you like to keep your selection for this record?" & vbCrLf & "[yes = change previous record's MyField; no = change MyField for this record]", vbYesNo Or VbMsgBoxStyle.vbExclamation Or vbSystemModal Or vbDefaultButton2 Or vbMsgBoxSetForeground, "Duplicate MyField selection encountered")
If selval = vbYes Then
' set focus to the other entry, preserving selection here
thissel = Me.MyControl.ListIndex
Me.MyControl.Value = "temp" ' if a string is okay & so we can jump away from this record
thisloc = Me.Form.CurrentRecord ' record number
rs.Findfirst (whereclause)
thatloc = Me.Form.CurrentRecord
Debug.Print (thisloc & "now ; was" & thatloc)
Me.MyControl.Value = "invalid"
DoCmd.GoToRecord , , acGoTo, thisloc ' jump to the new row
Me.MyControl.Value = newval
DoCmd.GoToRecord , , acGoTo, thatloc ' jump to the one to change
If thissel <= 0 Then thissel = 1 ' may not be useful, given the error handling below
On Error Resume Next
Me.MyControl.ListIndex = thissel - 1
On Error GoTo 0
Me.MyControl.Dropdown
ElseIf selval = vbNo Then
Me.MyControl.Value = Me.MyControl.OldValue
Me.MyControl.Undo ' for some reason this doesn't clear the "dirty" bit, resulting in the edit pencil showing up for the row.
Me.MyControl.SetFocus
End If
Else
Debug.Print ("There were no matches! Das ist gut")
End If
End Sub
Residual Issue(s)
Selecting "Yes" from the dialogue and then hitting escape puts the invalid "invalid" string into the box, which ignores any requirement to restrict the final selection to one in the list (ie Limit to List = 1). Ideally this would "roll back" the two rows.
Maybe I should change this to an OnExit Event so it doesn't trigger before I even leave the cell? Not sure if the primary key violation would happen before this triggers though. OnChange triggers much too frequently (every time you down-arrow through the list).
I have a form that adds new users. I'm trying to auto generate the username, which needs to be unique. I have a function checkUsername that takes the string passed and checks the db table to see if that username exists. It returns false if the username exists and true if not.
What I'm trying to do is if the username already exists then add a number on to the end and check again. I want to keep looping until a unqiue username is found. Heres my attempt at a loop below, however its returning usernames that already exist. Also I prefer it to increment the number rather than just adding it to the end. Currently the pattern ends up being username1, username12, username123.
'Generate username
Dim Username As String
Username = generateUsername(LCase(Left(FirstName, 1) & LastName))
Function generateUsername(Username As String) As String
Dim i As Integer
i = 1
Do While checkUsername(Username)
If checkUsername(Username) Then
Exit Do
Else
Username = Username & i
i = i + 1
End If
Loop
generateUsername = Username
End Function
What I would do is, when the username exists already (see Andre's answer for the code that will accomplish this a different way):
check what the previous "i" number was, as a string, to see how many characters I need to cut off the end of username
set username equal to a substring of username, which will cut off the last X characters (X being the number of characters the previous "i" was)
add the new "i" to the end username
That will solve your naming issue.
For your issue of looking for unique names, no one will be able to help with that until we can see what the code looks like for the "checkUsername" function. Make sure that that function is returning the value you are expecting, first. I suspect the problem is in there.
EDIT:
I also don't understand why you have an "If/Else" statement in your loop. You already determined that it was true. See below for simplified version (again, assuming I got the code right for VB...I usually do it in C#):
Do While Not checkUsername(NewName)
NewName = Username & i
i = i + 1
Loop
I assume checkUsername() returns true if the username exists?
Then your If condition is wrong - you want to exit if it doesn't exist.
Your loop gets clearer if you use two variables:
Function generateUsername(origUsername As String) As String
Dim i As Integer
Dim Username As String
i = 1
Username = origUsername
Do While checkUsername(Username)
' If Not checkUsername(Username) Then
' Exit Do
' Else
Username = origUsername & i
i = i + 1
' End If
Loop
generateUsername = Username
End Function
Edit: as pointed out by Joel, the additional checkUsername() in the loop isn't needed. Since it probably involves a DLookup or similar, it is actually harmful to performance.
I commented it out above.
Sorry, but this is the corrected version!
Change your code to this instead:
Dim Username As String
Username = generateUsername(LCase(Left(FirstName, 1) & LastName))
Function generateUsername(Username As String) As String
Dim NewName as String
Dim i As Integer
i = 1
NewName = Username
Do While checkUsername(NewName)
If checkUsername(NewName) Then
Exit Do
Else
NewName = Username & i
i = i + 1
End If
Loop
generateUsername = NewName
End Function
Consider:
Do Until rs.EOF = True
Me.vcTBConcatName.SetFocus
If IsNull(rs.Fields!contactname.Value) Then
Me.vcTBConcatName.Text = "No value recorded"
Else
Me.vcTBConcatName = rs.Fields!contactname
End If
rs.MoveNext
Loop
The object of this code snippet is to: set the focus on a textbox (vcTBConcatName), check whether a value for contactname exists in a record set, populates the textbox with the value if it exists, or populates the textbox with No value recorded if not.
The code runs, and populates the textbox ONLY if there is a value for contactname in the recordset. No alternative text is placed in the textbox in case there is no value returned for contactname.
Could someone point to what I am doing wrong please?
Maybe this will work for you. If you are just searching for a value, you don't have to loop through the recordset:
Me.vcTBConcatName.SetFocus
rs.FindFirst "[contactname] IS NOT NULL AND [contactname] <> ''"
If rs.NoMatch Then
Me.vcTBConcatName = "No value recorded"
Else
Me.vcTBConcatName = rs.Fields!contactname
End If
The code looks for the first NOT NULL in ContactName in the recordset; if it finds it, it will use that name, if not update to say no value recorded.
EDIT: After long and hard debugging, turns out to be 0-length string was culprit. Added [contactname] <> '' to the FindFirst statement to make sure it was looking for those as well.
I have a timesheet system in excel with 3 rows (standard time, overtime, double time) for each of our (100+) employees, and one column for each cost code on the site. This ends up being a giant matrix, most of which is empty. My solution is to basically create an employee datatype which stores the employee information and hours for a single cost code.
Public Type Employee
Name As String
Trade(1 To 3) As String
EmpNum As Long
Comment As String
AddOns(1 To 3) As Single
Allowance(1 To 3) As Single
Contract As Long
CostCode As Long
STHours As Single
OTHours As Single
DTHours As Single
WorkDate As Date
End Type
I can process the spreadsheet and organize the information in excel as an array of employee-type objects, but I'm not familiar with how to export this into Access, and most questions relate to exporting from excel cells to Access. I can obviously put these objects into cells on another worksheet and do it that way, but it seems like there should be a better way.
Currently my best guess is something like this:
Insert data form Excel to Access 2010 using VBA
but then I'd be making 100+ updates to the table for each export.
Is there an efficient way to create a table object in VBA, populate it with the array information, and then append it to the end of my table in Access in a single update?
Thanks.
-Sean
The easiest way is to create a table link in Access. Table links look like tables in the rest of Access, but the data is stored externally. The data could be inside another Access database, or inside a SQL Server database, or what have you.
In particular, the data can be in an Excel spreadsheet. Define a table in Excel that contains the data in the format that's right for your Access application. Then build a table link in Access that links back to the table you defined in Excel.
When you update the Excel table, the updated results will automatically appear the next time you reference the table link in Access.
thanks for the help from everyone ... I just wanted to share what I came up with for a solution. I ended up building a function to insert one object into the database ... copied and modified from the interwebs. Code below, cheers!
Public Function InsertTimeRecord(EmpData As Employee) As Boolean
Dim SaveTime As Date
Dim db As DAO.Database
Dim rs As DAO.Recordset
'//Database Location
Const DB_LOCATION = "C:\access\KMP Tracker.mdb"
'//If errors occur the function will exit with a return value of false (insertion failed)
On Error GoTo ErrHandler:
'//Table has a datecreated/datemodified timestamp for each record
SaveTime = Now
'//Open Database
If db Is Nothing Then
Set db = DAO.Workspaces(0).OpenDatabase("C:\access\KMP Tracker.mdb") 'Removed DB_LOCATION
End If
'//Open Table
If rs Is Nothing Then
Set rs = db.OpenRecordset("Timesheet Data", dbOpenDynaset)
End If
'//Create a new record
With rs
.AddNew
![EmpName] = EmpData.Name
![Trade1] = EmpData.Trade(1)
![Trade2] = EmpData.Trade(2)
![Trade3] = EmpData.Trade(3)
![EmpNum] = EmpData.EmpNum
![Comment] = EmpData.Comment
![AddOns1] = EmpData.AddOns(1)
![AddOns2] = EmpData.AddOns(2)
![AddOns3] = EmpData.AddOns(3)
![Allowance1] = EmpData.Allowance(1)
![Allowance2] = EmpData.Allowance(2)
![Allowance3] = EmpData.Allowance(3)
![Contract] = EmpData.Contract
![CostCode] = EmpData.CostCode
![STHours] = EmpData.STHours
![OTHours] = EmpData.OTHours
![DTHours] = EmpData.DTHours
![WorkDate] = EmpData.WorkDate
![DateSubmitted] = SaveTime
'//Insert Record into Database
.Update
InsertMachineHoursRecord = True '//SUCCESSFUL INSERTION
End With
'//Note that we use recordset in this example, but equally effective
'// is to create an update query command text and simply run the update query:
'// (INSERT INTO Table (Field1, Field2) VALUES (Value1, Value2);
'//Make sure we have closed the database
My_Exit:
rs.Close
Set rs = Nothing
db.Close
Set db = Nothing
Exit Function
ErrHandler:
MsgBox Err.Description
Resume My_Exit
End Function
I'm trying to write a validation function that checks to see if an entry being added already exists in the dataset.
But the search doesn't pick it up - i can just keep entering the same appointment into the database.
If anyone can spot why my code isn't working, i'd appreciate the help.
Thanks
Public Function checkNewLocationRecordIsUnique As Boolean
Dim s As New NotesSession
Dim w As New NotesUIWorkspace
Dim db As NotesDatabase
Dim selectView As NotesView
Dim key(0 To 4) As Variant
Dim entry As NotesViewEntry
Dim entryIsNotUniqueMsg As String
Let entryIsNotUniqueMsg = "There is already an entry for this date/time. Please modify your entry's details or cancel the existing entry to continue."
Dim thisDoc As NotesDocument
Dim uiDoc As NotesUIDocument
Set uidoc = w.CurrentDocument
Set thisDoc = uidoc.Document
'get handle to database and check we've found the database
Set db = s.CurrentDatabase
If Not db Is Nothing Then
'get handle to view to lookup field combination in
Set selectView = db.GetView("allLocationRecordsByName")
Call selectView.Refresh()
If Not selectView Is Nothing Then
'populate "key" - an array of variants - with fields to use as match criteria
key(0) = thisDoc.PersonName
key(1) = thisDoc.StartDate
key(2) = thisDoc.EndDate
key(3) = thisDoc.StartTime
key(4) = thisDoc.EndTime
Set entry = selectView.GetEntryByKey(thisDoc.key, True)
'lookup the combination in the view to see if it already exists
If entry Is Nothing Then
MsgBox "No conflicting entry found! Record added.", 0, "Notice"
'if it wasn't found then the record is unique so return true
checkNewLocationRecordIsUnique = True
Else
'else the combination was found - but lets make sure that it's not this one
'(this could happen if the user is editing an existing record)
'compare uids of both thisDoc and the doc entry that was found
If entry.document.UniversalID = thisDoc.UniversalID Then
checkNewLocationRecordIsUnique = True
MsgBox "An Entry Was Found, But It Was The Entry! Record added.", 0, "Notice"
'else it WAS found as a separate document so the function returns false
Else
MsgBox entryIsNotUniqueMsg, 0, "Error: Entry Is Not Unique"
checkNewLocationRecordIsUnique = False
End If
End If
End If
End If
End Function
thisDoc.PersonName returns an array, you probably need to use
key(0) = thisDoc.PersonName(0)
key(1) = thisDoc.StartDate(0)
key(2) = thisDoc.EndDate(0)
key(3) = thisDoc.StartTime(0)
key(4) = thisDoc.EndTime(0)
You are using five lines of code to populate a local variant array called key, but you are not actually using that array for your GetEntryByKey call.
So my guess is that you want the code to say this:
Set entry = selectView.GetEntryByKey(key, True)
instead of this:
Set entry = selectView.GetEntryByKey(thisDoc.key, True)
Is the view allLocationRecordsByName sorted on each column included in the search key?
See GetEntryByKey documentation.