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.
Related
I have been trying to get the path to a linked table. I am looping thru the tables. it works one the first loop but not on the 2nd loop. it returns "".
Ive tried several different ways, calling the table by name or by number. the code originally comes from Neville Turbit. Neville's code calls the table by name, but I could not get that to work.
Public Function GetLinkedDBName(TableName As String)
Dim tblTable As TableDef
Dim strReturn As String
Dim i As Integer
On Error GoTo Error_NoTable ' Handles table not found
'---------------------------------------------------------------
'
i = 0
On Error GoTo Error_GetLinkedDBName ' Normal error handling
For Each tblTable In db.TableDefs
If tblTable.Name = TableName Then
strReturn = tblTable.Connect
strReturn = db.TableDefs(i).Connect
Exit For
End If
i = i + 1
Next tblTable
You don't need a loop:
Public Function GetLinkedDBName(TableName As String) As String
Dim strReturn As String
On Error Resume Next ' Handles table not found
strReturn = CurrentDb.TableDefs(TableName).Connect
GetLinkedDBName = strReturn
End Function
This is my modification from Gustav's.
CurrentDb.TableDefs(TableName).Connect command will returns a string like this:
"MS Access;PWD=p455w0rd;DATABASE=D:\Database\MyDatabase.accdb"
The string above contains 3 information and parted by ";" char.
You need to split this information and iterate through it to get specific one which contain database path.
I am not sure if different version of ms access will return exact elements and with exact order of information in return string. So i compare the first 9 character with "DATABASE=" to get the index of array returns by Split command and get path name from it.
Public Function getLinkedDBName(TableName As String) As String
Dim infos, info, i As Integer 'infos and info declared as Variant
i = -1
On Error Resume Next ' Handles table not found
'split into infos array
infos = Split(CurrentDb.TableDefs(TableName).Connect, ";")
'iterate through infos to get index of array (i)
For Each info In infos
i = i + 1
If StrComp(Left(info, 9), "DATABASE=") = 0 Then Exit For
Next info
'get path name from array value and return the path name
getLinkedDBName = Right(infos(i), Len(infos(i)) - 9)
End Function
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
The 1st record in the open order table matches a record in the Bookings table but the NO MATCH = True is happening and therefore it goes down thru the code anf tries to insert a new record. This is true for several records in the file and it tries to add the record even though there is a match. If I set the NO MATCH = False then it does the else. I imported these table from Access 97 to 2010 where it is working correctly. Any help would be appreciated.
Additional note: While in Debug, If I hover the mouse over the .Seek "=", TempCust, TempPart fields, it shows the 1st record in the table and that data is in the Bookings table. Not understanding why it is not matching?
Sub Get_Current_Info()
DoCmd.SetWarnings False
Dim rstOpenOrd, rstBookings As Recordset
Dim TempCust, TempPart, TempQty, TempDollars As Variant
Set rstOpenOrd = CurrentDb.OpenRecordset("Open Orders", dbOpenTable)
Set rstBookings = CurrentDb.OpenRecordset("Bookings", dbOpenTable)
'Get the open orders
Do While Not rstOpenOrd.EOF
With rstOpenOrd
TempCust = !ODCSNO
TempPart = !ODITNO
TempQty = !ODQTOR
TempDollars = !OrdDollars
End With
With rstBookings
.Index = "PrimaryKey"
.Seek "=", TempCust, TempPart
If rstBookings.NoMatch = True Then
With rstBookings
.AddNew
!cusno = TempCust
!PrdNo = TempPart
!Qty_booked = TempQty
!Dol_booked = TempDollars
!Yest_qty_booked = 0
!Yest_dol_booked = 0
!Shipped_qty = 0
!Shipped_dol = 0
.Update
End With
Else
With rstBookings
.Edit
!Qty_booked = !Qty_booked + TempQty
!Dol_booked = !Dol_booked + TempDollars
.Update
End With
End If
End With
rstOpenOrd.MoveNext
Loop
End Sub
This line suppresses information, including many types of error information ...
DoCmd.SetWarnings False
I don't see why you would want it at all in this procedure. But, at least during troubleshooting, make sure SetWarnings is on ...
'DoCmd.SetWarnings False
DoCmd.SetWarnings True
The point is that you need every possible tidbit of information you can get while troubleshooting. Don't suppress any of it.
The code would not do what you expect if the Bookings table does not include an index named PrimaryKey, or if that index does not include cusno and PrdNo (in that order) as its first 2 keys.
But that is just speculation. You need to test with SetWarnings on and see whether Access gives you useful details.
You must dim your variables or they are just Variant/Object:
Dim rstOpenOrd As DAO.Recordset
Dim rstBookings As DAO.Recordset
I have a Repoerteq table with a REQ_NUM as ID and another column named "REQ_department".
REQ_department have defult values such as ""Finance".
I want to make VBA looks at the department and then set a prefix formate for REQ_NUM
example is department is finance then it would make id as "FIN 000"
the following code is what i manage fo far but it still not working
Option Compare Database
Function GetData() As String
Dim db As Database
Dim Rrs As DAO.Recordset
Dim RSQL As String
Dim RepData As String
Dim RepDep As String
'TO open connection to current Access DB
Set db = CurrentDb()
'TO create SQL statement and retrieve value from ReportReq table
RSQL = "select * from ReportReq"
Set Rrs = db.OpenRecordset(RSQL)
'Retrieve value if data is found
If Rrs.EOF = False Then
RepData = Rrs("REQ_NUM")
RepDep = Rrs("Req_department")
Else
RepData = "Not found"
RepDep = "Not found"
End If
Lrs.Close
Set Lrs = Nothing
GetData = RepData
If ReqDep = "finance" Then
Range("REQ_NUM") = Format$("FIN", REQ_NUM)
End If
End Function
You'll have to change your call to the Format() function which tries to format a number or date according to the format string. In addition, you're using an undefined variable REQ_NUM.
If ReqDep = "finance" Then
Range("REQ_NUM") = "FIN " & Format$("000", CLng(RepData))
' ^^^^^^ ^^^^^^^^^^^^^^^^^^^^
End If
Can anyone spot an obvious reason as to why my save function isn't saving the fields in my form? It saves the document, but the fields are empty when I open it up. The following code is what I'm using:
Public Sub co_loopNamesAndSaveDocs()
'Dim variables
Dim s As New NotesSession
Dim thisDatabase As NotesDatabase
Set thisDatabase = s.CurrentDatabase
Dim ws As New NotesUIWorkspace
Dim uidoc As NotesUIDocument
Set uidoc = ws.CurrentDocument
Dim currentDoc As NotesDocument
Set currentDoc = uidoc.Document
Dim newDoc As NotesDocument
Dim PersonNameField As NotesItem
Set PersonNameField = currentDoc.GetFirstItem("PersonName")
'Loop through values in PersonNameField and create a new document for each value found
Forall pName In PersonNameField.Values
Set newDoc = New NotesDocument (thisDatabase)
newDoc.Form="newLocationForm"
newDoc.StartDate = currentDoc.StartDate(0)
newDoc.EndDate = currentDoc.EndDate(0)
newDoc.Duration = currentDoc.Duration(0)
newDoc.StartTime = currentDoc.StartTime(0)
newDoc.EndTime = currentDoc.EndTime(0)
newDoc.Comments = currentDoc.Comments(0)
newDoc.Status = currentDoc.Status(0)
newDoc.LocationCode = currentDoc.LocationCode(0)
newDoc.PersonName = pName
Call newDoc.Save (True, False, False)
End Forall
End Sub
Thanks in advance.
Since I don't see an obvious error in the coding, I'd say that the fields in newDoc are blank because the fields in currentDoc are blank. And since currentDoc was set to uidoc.Document, that probably means that you have a synch problem between front-end and back-end documents. I.e., the values exist in your uidoc, but have not yet been saved to the back-end prior to calling this code. If I'm right, try calling uidoc.save() before assigning currentDoc. If you don't want to save to the back-end, then instead of using the back-end as your data source you should be using uidoc.fieldGetText("PersonName") and parsing out the values.