Working on this for awhile now and i'm getting runtime error 2501
i'm trying to pull up a record after the message box appears stating that a duplicate has been found and upon clicking "OK" pulls up the record.
i have been tinkering with the DoCmd.FindRecord, DoCmd.GoToRecord, and DoCmd.OpenForm methods to no avail.
Any help would be greatly appreciated.
Thanks in advance.
Private Sub MRN_BeforeUpdate(Cancel As Integer)
Dim Answer As Variant
Answer = DLookup("[MRN]", "Requests Processed", "[MRN] = '" & Me.MRN & "'")
If Not IsNull(Answer) Then
MsgBox "Existing MRN found" & ": " & MRN.Text & vbCrLf & vbCrLf & "Please SEARCH and EDIT on EXISTING Record.", vbCritical + vbOKOnly + vbDefaultButton1, "EXISTING MRN FOUND"
Cancel = True
Me.MRN.Undo
Else:
End If
DoCmd.OpenForm "Requests Processed", , , Answer
End Sub
From the help topic, the OpenForm method's WhereCondition option is "A string expression that's a valid SQL WHERE clause without the word WHERE."
Try OpenForm this way ...
DoCmd.OpenForm "Requests Processed", , , "[MRN] = '" & Answer & "'"
It looks to me like that could work. However it seems you can use the same string for both your DLookup Criteria option and your OpenForm WhereCondition. If that's true create one string variable (eg strWhere) and use it in both places.
Related
I'm working on an Access database with a SQL Server back end. Some times when I open a particular form, I get an Error 3146 "Column has been specified more than once in the order by list."
There are several possible queries that might feed into this form but I checked and ran them all individually and they run fine, so it's something in the form but I'm not sure. Below is a screen shot of the Data Properties window. My hypothesis is that "Order By" property (which I did not populate manually) is not being cleared out when the form closes, and thus when the form is re-opened, that in effect puts in the same columns twice.
I can temporarily solve the problem by opening up the form and clearing those Filter and Order By fields. That solves it for a while but intermittently it will happen again so there's probably one other thing I'm overlooking. I put in code in the Form close event to set the orderby="" but even that doesn't totally solve it.
Here is the code that opens the form from the main menu (frmProdSched is the form in question)
Private Function OpenProdSched(RunQuery, RunCaption)
DoCmd.OpenForm "frmProdSched", , RunQuery, "", , acNormal
Forms!frmProdSched.Caption = RunCaption
gScheduleRptQry = RunQuery
Me.Refresh
End Function
and then the code that is in the Form_Current event
Private Sub Form_Current()
On Error Resume Next
Dim strForm As String
Dim strForm1 As String
Dim strWhere As String
strForm = "frmSubmittalStatus"
strForm1 = "frmProdSched"
strWhere = "StatusJobno = " & Me.JOBNO & ""
If IsLoaded(strForm) Then
If Forms(strForm).Filter = strWhere Then
Forms(strForm1).SetFocus
Else
DoCmd.Close acForm, strForm
DoCmd.OpenForm FormName:=strForm, WhereCondition:=strWhere
Forms(strForm1).SetFocus
End If
End If
End Sub
I tried adding this code to the Form Close event and it seemed to work most of the time but it still intermittently happens
Private Sub Form_Close()
Me.Filter = ""
Me.OrderBy = ""
End Sub
I'm not sure what to check next. Any ideas?
I am fairly new to MS Access, but have a decent understanding of databases, with some knowledge of SQL.
I am creating a database in Access. On a main form that users will see first, I need to display a count of all records from my Case table, which have a StatuteOfLimitation date that is within the next year.
My goal was to create a label describing the information, with a button below it. The button will open a report of all of the records (this part is working fine), and I wanted the caption for the button to display the total count of how many records meet the criteria.
The only way I can think to do it, is to retrieve the count and store it into a variable. From there, I should be able to set the caption to the variable value.
I have seen a few methods of retrieving a count and storing it in a variable, but all that I found only stored a count of EVERY record, without filtering for the date range.
This was the best that I could think of, but it is not working:
Private Sub Form_Load()
Dim oneYearFromToday As TempVars
SET TempVars!oneYearFromToday = (SELECT COUNT(StatuteOfLimitation) FROM Case
WHERE StatuteOfLimitation <= DateAdd("yyyy", 1, Date());
End Sub
DCount() provides a simple approach for "How to retrieve a count of all records where a Date field is within the next year"
Dim lngCount As Long
lngCount = DCount("*", "Case", "[StatuteOfLimitation] <= DateAdd('yyyy', 1, Date())")
Then you can use that count in your command button's Caption property. Say the button is named cmdOpenReport ...
Me!cmdOpenReport.Caption = "Report " & lngCount & " cases"
If you want the count in a TempVar instead of a regular Long variable, declare it As TempVar (just one) instead of As TempVars (a collection). And when you assign the value to it, don't use Set.
Dim oneYearFromToday As TempVar
TempVars!oneYearFromToday = DCount("*", "Case", "[StatuteOfLimitation] <= DateAdd('yyyy', 1, Date())")
I probably wouldn't use a tempvar to store your variable. you can try something like below using the DAO.
Private sub Form_Load()
dim rst as dao.recordset
dim strSQL as string
'Creates query string
strsql = "SELECT Count(StatueOfLimitation) as RecordCount " & _
"FROM Case " & _
"WHERE (((StatueOfLimitation) <= DateAdd('yyyy',1,date())));"
'Opens the query string into a recordset
set rst = currentdb.openrecordset(strsql)
'Change Labelnamehere isnto the name of the label control on your form
'Change what ever saying you want here to something you want the label to display
me.labelnamehere.caption = "What ever saying you want here " & rst![RecordCount] 'Don't need a variable storage is you can use the result here
rst.close 'closes recordset
set rst = nothing 'Clears memory
EndCode: 'Ensures clean up is successful
If not rst is nothing then
rst.close
set rst = nothing
end if
end sub
If this doesn't work for you, please let me know and I'll do some more digging.
I'm not able to comment on HansUp's answer, but to change a label caption in VBA you need to open the form in Design view. It's not something I typically do, my personal preference is to use an unbound text box with labels that don't change, but I have done it in one database to update the time/date and user for the last email sent.
The code would look like this:
DoCmd.OpenForm "yourformname", acDesign, , , , acHidden
Forms![yourformname]![yourlabelname].Caption = "There are " & TempVars!onYearFromToday & " cases to view."
DoCmd.Close acForm, "yourformname", acSaveYes
DoCmd.OpenForm "yourformname", acNormal
It's a bad idea to use a button for info display. That's not the purpose of a button.
Use a textbox and set its ControlSource:
=DCount("*","[Case]","[StatuteOfLimitation]<=DateAdd("yyyy",1,Date()))
It will fill by itself, and the button is free to open the report at any time.
I have a "remove" button on a continuous form that performs the following SQL when clicked:
Dim strSQL As String
strSQL = "Delete SLIDE_NAME, COB_TITLE, COB_ID, COB_CATEGORY " _
& "FROM tbl_SLIDE_LIST " _
& "WHERE SLIDE_NAME='" & strSlideName & "' AND COB_TITLE='" & strCOB_TITLE & "';"
CurrentDb.Execute (strSQL)
The button sits on the continuous form like so:
There must be some sort of initialization I need to perform to make this work properly -
I can delete the 2nd and 3rd records with no problem, but if I click the "remove" button on the first record, the subform becomes blank, as if I deleted all records - (which is not actually the case). Then if I reselect the "Test Slide" to look at what actually happened, I receive the error "The data has been changed" Another user edited this record and saved the changes before you attempted to save your changes.
What is happening here and what do I need to do to make this work correctly?
If you delete a record with SQL, the form doesn't know about it. You need to do Me.Requery afterwards.
Much simpler would be to run DoCmd.RunCommand acCmdDeleteRecord.
From http://access.mvps.org/access/RunCommand/codeex/50-223.htm :
'Code from Microsoft Knowledge Base Adapted by Terry Wickenden
Private Sub cmdDelete_Click()
On Error GoTo Err_cmdDelete_Click
DoCmd.SetWarnings False
If MsgBox("Confirm deletion of the record?", vbQuestion + vbYesNo + vbDefaultButton2, "Delete?") = vbYes Then
DoCmd.RunCommand acCmdSelectRecord ' I think this isn't needed
DoCmd.RunCommand acCmdDeleteRecord
End If
Exit_cmdDelete_Click:
DoCmd.SetWarnings True
Exit Sub
Err_cmdDelete_Click:
MsgBox Err.Description
Resume Exit_cmdDelete_Click
End Sub
I've posted here before under a different account name and thanks all for previous help.
I have a spreadsheet which extracts information from a Data Historian, to generate a report on the status of the factory which is then automatically emailed out via Lotus Notes to recipients at fixed time intervals.
Sometimes there may be network issues affecting either the factory DCS, Data Historian (Aspen), or Lotus Notes. This gives a run time error when the script runs. Usually all that is required is to end the script, wait a period of time, recalculate the sheet, and then re-run the script.
Was hoping somebody could advise what code to add to achieve this. All I really need to know is what code to write and where to insert it to end the script in the event of a run-time error, and then to trigger another sub-routine in which I can add an application.wait and application.calculate before re-running the script. I need the script to end and run a separate sub as it causes issues with multiple scheduled events otherwise which then ultimately sends out multiple emails.
I've marked the part of the script that usually fails.
Sub Macro6()
Windows("Silo report 2 hourly.xlsm").Activate
' Range("A1").Select
'Calculate all workbooks
Application.Calculate
'Set up the objects required for Automation into lotus notes
Dim Maildb As Object 'The mail database
Dim UserName As String 'The current users notes name
Dim MailDbName As String 'THe current users notes mail database name
Dim MailDoc As Object 'The mail document itself
Dim AttachME As Object 'The attachment richtextfile object
Dim Session As Object 'The notes session
Dim EmbedObj As Object 'The embedded object (Attachment)
'Start a session to notes
Set Session = CreateObject("Notes.NotesSession")
'Next line only works with 5.x and above. Replace password with your password
'Get the sessions username and then calculate the mail file name
'You may or may not need this as for MailDBname with some systems you
'can pass an empty string or using above password you can use other mailboxes.
UserName = Session.UserName
MailDbName = Left$(UserName, 1) & Right$(UserName, (Len(UserName) - InStr(1, UserName, " "))) & ".nsf"
'Open the mail database in notes
Set Maildb = Session.GETDATABASE("", MailDbName)
If Maildb.IsOpen = True Then
'Already open for mail
Else
Maildb.OPENMAIL
End If
'Set up the new mail document
Set MailDoc = Maildb.CreateDocument
MailDoc.Form = "Memo"
vaRecipient = VBA.Array("xxx.xxx#xxx.com", "yyy.yyy#yyy.com", "zzz.zzz#zzz.com")
MailDoc.SendTo = vaRecipient
MailDoc.Subject = Range("B1").Value
Set workspace = CreateObject("Notes.NotesUIWorkspace")
'**THE RUNTIME ERROR USUALLY OCCURS WITHIN THE NEXT 5 LINES OF SCRIPT**
Dim notesUIDoc As Object
Set notesUIDoc = workspace.EditDocument(True, MailDoc)
Call notesUIDoc.GOTOFIELD("Body")
Call notesUIDoc.FieldClear("Body")
Call notesUIDoc.FieldAppendText("Body", Range("B9").Value & vbCrLf & vbCrLf & Range("b10").Value & Range("I10").Value & Range("D10").Value & vbCrLf & Range("b11").Value & Range("I11").Value & Range("D11").Value & vbCrLf & Range("b12").Value & Range("I12").Value & Range("D12").Value & vbCrLf & vbCrLf & Range("b13").Value & Range("I13").Value & Range("D13").Value & vbCrLf & vbCrLf & Range("b14").Value & Range("C14").Value & Range("D14").Value & vbCrLf & vbCrLf & Range("b15").Value & Range("I15").Value & Range("D15").Value & vbCrLf)
notesUIDoc.Send
notesUIDoc.Close
MailDoc.PostedDate = Now() 'Gets the mail to appear in the sent items folder
'MailDoc.Send 0, vaRecipient
'Clean Up
Set Maildb = Nothing
Set MailDoc = Nothing
Set AttachME = Nothing
Set Session = Nothing
Set EmbedObj = Nothing
End Sub
In LotusScript as well as in Visual Basic / VBA the error handling works exact the same. At the beginning of your Script you define where to go if an error occurs:
On Error Goto ErrorHandler
Place a Jump- Mark above the line, where you want to start over, when the error occurs:
TryAgain:
At the very end of your sub you define the errorhandler itself:
EndSub:
'- prohibit that error handler is called without an error
Exit Sub
ErrorHandler:
'- here you can react on the error, e.g. check for the err (Error number)
If err = NumberOfErrorThatOccursWhenNetworkErrorOccurs then
'- wait some time to give the network time to recover
Sleep x '- put in x as best for your problem
'- jump back
Resume TryAgain
Else
'- another error occured: inform user
Messagebox err & ", " & Error & " in line " & Erl
'- now jump to the end of the sub
Resume EndSub
End If
Of course this is a minimal errorhandling, and probably you would not want to jump around without further checks, but the idea should be clear with this example.
Just one more thing from the comments: you don't need the ui- stuff at all! Just omit it, as it is totally unneccessary and makes your code unstable.
Replace the whole paragraph starting with Set workspace... ending with notesUIDoc.close with two lines of code:
Call Maildoc.ReplaceItemValue( "Body", Range("B9").Value ..... )
Call Maildoc.Send( False )
Then you don't have to take care if something goes wrong - the document will just be discarded when the code runs again or ends, and it will be much more stable than handling ui windows and the screen will not flicker...
I'm fighting with creation of several forms in MS Access 2007.
I accomplished the following: I have patients form, where I can create / edit patient records. When save button is pressed, I'm opening another form, that has a task of entering information that belong to 2 tables. Tables on that form are in 1-1 relationship, and both use foreign key (patiendID from patients table).
I managed to make everything work fine - when I update / save new patient, I have a new form opened with a bunch of lab results to be entered. Some of the results belong to one table, and other to another table. patientID field, that is also visible on that 2nd form is set as it should be. However, when I try to enter ANY value in ANY field on that form - I get following warning on the status bar: "This Recordset is not updateable".
I think that this has smt to do with the fact that I actually opened 2 tables on a single form, but I might be very wrong.
Here is the code I use to open 2nd form:
Private Sub save_Click()
Dim m_query As String
m_query = "INSERT INTO labresults (patientID) VALUES (" & Me.ID & ")"
If Me.Dirty = True Then
Me.Dirty = False
End If
If DCount("patientID", "labresults", "patientID = " & Me.ID) = 0 Then
CurrentDb.Execute m_query, dbFailOnError
End If
m_query = "INSERT INTO par14MO (patientID) VALUES (" & Me.ID & ")"
If DCount("patientID", "par14MO", "patientID = " & Me.ID) = 0 Then
CurrentDb.Execute m_query, dbFailOnError
End If
If CurrentProject.AllForms("labresults").IsLoaded = True Then
Forms![labresults]![patientID] = Me.ID
Forms![par14MO]![patientID] = Me.ID
Else
DoCmd.OpenForm "labresults", acNormal, , "idPAcijenta = " & Me.ID, acFormEdit, acWindowNormal, Me.ID
End If
End Sub
Any ideas what's going on???
Thx a bunch!
I'm still googling and trying... I'll post my findings if I manage to sort things out!
Turns out that this really cannot be done :). Closing this one, and assuming this is an answer.
Edit: It was suggested to me that my last statement is not true. However, I solved things "manually", and everything is ok now. I'll go on and accept this answer in order to keep my response at a good level.