ISSUE
I have two forms:
frmForms
frmDockRental
I have two controls associated with this issue:
lstOwners on frmForms (unbound)
cboOwner on frmDockRental (unbound)
The second form (frmDockRental) is opened using different listboxes located on frmForms (See Image). I have one such listbox that's giving me grief. It is a filtered list of contacts that when double-clicked it should be opening frmDockRental to a NEW record and set cboOwner, which is unbound, to a specific item in the list. The same item listed in lstOwners from frmForms.
CODE
After a lot of fiddling, I came up with this - except nothing happens at all.
Private Sub lstOwners_DblClick(Cancel As Integer)
On Error GoTo lstOwners_DblClick_Err
On Error Resume Next
If (Form.Dirty) Then
DoCmd.RunCommand acCmdSaveRecord
End If
If (MacroError.Number <> 0) Then
Beep
MsgBox MacroError.Description, vbOKOnly, ""
Exit Sub
End If
On Error GoTo 0
Exit Sub
DoCmd.OpenForm "frmDockRental", acNormal, "", "", acFormAdd, acDialog, Me.lstOwners
DoCmd.Close acForm, Me.Name
lstOwners_DblClick_Exit:
Exit Sub
lstOwners_DblClick_Err:
MsgBox Error$
Resume lstOwners_DblClick_Exit
End Sub
And on frmDockRental, this:
Private Sub Form_Load()
On Error GoTo Form_Load_Err
DoCmd.MoveSize , , 5.3 * 1440, 5.2 * 1440
' If (IsNull(OpenArgs)) Then
' Exit Sub
' End If
If Me.OpenArgs <> vbNullString Then
Me.cboOwner = Me.OpenArgs
End If
If (Not IsNull(OpenArgs)) Then
DoCmd.GoToRecord , "", acNewRec
End If
Form_Load_Exit:
Exit Sub
Form_Load_Err:
MsgBox Error$
Resume Form_Load_Exit
End Sub
I figured OpenArgs would be the best method to accomplish this, but it just doesn't work. Nothing at all happens. No errors, just nothing.
EDIT:
Here's an image of the step debugging.
I've been trying a couple things to create a button that navigates back to the first record you are at the last record. I get the "can't go to specified record" error. Here are the two styles of code I have tried for this button:
Private Sub Command161_Click()
On Error Resume Next
If Me.CurrentRecord = acLast Then
DoCmd.GoToRecord , , acFirst
Else
DoCmd.GoToRecord , , acNext
End If
End Sub
Private Sub Command161_Click()
With Me.Recordset
If .AbsolutePosition = .RecordCount - 1 Then
DoCmd.GoToRecord , , acFirst
Else
DoCmd.GoToRecord , , acNext
End If
End With
End Sub
The goal is to loop back around to the first record without allowing the user to create a new record. I've tried this code with "allow additions" set to both yes and now, with the same result. Any help would be appreciated.
I would suggest defining a private predicate function within your form module which returns a boolean value depending on whether or not the active form is displaying the last record in its Record Source.
Such a function might be written:
Private Function LastRecordP() As Boolean
With Me.RecordsetClone
If Not .EOF Then
.MoveLast
.MoveFirst
LastRecordP = Me.CurrentRecord = .RecordCount
End If
End With
End Function
Your OnClick event handler for your button control could then be written more succinctly as:
Private Sub Command161_Click()
If LastRecordP Then
DoCmd.GoToRecord , , acFirst
Else
DoCmd.GoToRecord , , acNext
End If
End Sub
Alternatively, you could allow the function to accept a Form object as an argument and evaluate such function using the Me keyword, e.g.:
Private Function LastRecordP(Frm As Form) As Boolean
With Frm.RecordsetClone
If Not .EOF Then
.MoveLast
.MoveFirst
LastRecordP = Frm.CurrentRecord = .RecordCount
End If
End With
End Function
Private Sub Command20_Click()
If LastRecordP(Me) Then
DoCmd.GoToRecord , , acFirst
Else
DoCmd.GoToRecord , , acNext
End If
End Sub
My intent is to deny users that do not meet a certain access level access to forms. I initially had issues with error code 3265 while writing the code for:
TempVars("EmployeeType").Value = rs!EmployeeType_ID.Value
This is no longer an issue; however, I cannot get access to the form even when the appropriate user is trying to enter. I've checked the spelling of table and column names multiple times as well.
Below is my code for the login (where I'm using the tempvars), followed by the code in form Load().
Option Compare Database
Option Explicit
Private Sub btnLogin_Click()
Dim rs As Recordset
Set rs = CurrentDb.OpenRecordset("Employees", dbOpenSnapshot, dbReadOnly)
rs.FindFirst "UserName='" & Me.txtUserName & "'"
If rs.NoMatch = True Then
Me.lblWrongUser.Visible = True
Me.txtUserName.SetFocus
Exit Sub
End If
Me.lblWrongUser.Visible = False
If rs!Password <> Me.txtPassword Then
Me.lblWrongPass.Visible = True
Me.txtPassword.SetFocus
Exit Sub
End If
If IsNull(Me.txtUserName) Or IsNull(Me.txtPassword) Then
MsgBox "You must enter password or login ID.", vbOKOnly + vbInformation, "Required Data"
Me.txtUserName.SetFocus
Exit Sub
End If
Me.lblWrongPass.Visible = False
If rs!EmployeeType >= 4 Then
Dim prop As Property
On Error GoTo SetProperty
Set prop = CurrentDb.CreateProperty("AllowBypassKey", dbBoolean, False)
TempVars("UserName").Value = Me.txtUserName.Value
TempVars("EmployeeType").Value = rs!EmployeeType_ID.Value
CurrentDb.Properties.Append prop
SetProperty:
If MsgBox("Would you like to turn on the bypass key?", vbYesNo, "Allow Bypass") = vbYes Then
CurrentDb.Properties("AllowBypassKey") = True
Else
CurrentDb.Properties("AllowBypassKey") = False
End If
End If
Me.Visible = False
DoCmd.OpenForm "frmMain"
Globals.LoggingSignOn "Logon"
End Sub
Private Sub Form_Load()
Me.txtUserName = Null
Me.txtPassword = Null
Me.txtUserName.SetFocus
End Sub
Private Sub Form_Unload(Cancel As Integer)
Globals.LoggingSignOn "Logoff"
End Sub
Private Sub Form_Load()
If Nz(DLookup("HasAccess", "tbl9EmployeeAccess", "EmployeeType_ID=" & TempVars("EmployeeType") & " FormName='" & Me.Name & "'"), False) = False Then
MsgBox "You do not have access to access this location."
DoCmd.Close acForm, Me.Name
End If
End Sub
Thank you for your time, to anybody that looks into this.
I have been desperately trying to find a way to make a calendar in Access. I know it can be done, as I've seen wonderful examples, but I don't know how. (Also, my VB knowledge is minimal.)
Basically, I want the calendar to show a range of dates of when a program (we call them capsules) has been checked out, and when it will be returned.
DateReserve - the Date a capsule has been reserved
DateReturn - the Date when the capsule needs to be returned.
For example, if Capsule A is reserved on 6/1/2014 and will return 6/14/2014, I want the calendar to visually show that Capsule A will be unavailable during this time period. That way, we don't accidentally double-book a capsule.
Through one of my many google searches, I did find VB code that pulls up a very nice looking calendar. I just can't get the code right to visually show what dates a capsule will be unavailable.
Below is one of the sections of code I can't get to work right:
Private Sub OpenContinuousForm(ctlName As String)
Dim ctlValue As Integer
Dim DaysOfMonth As Long
Dim DateReturn As Date
Dim DateShipOut As Date
Dim DateRangeForProgram As String
DateRangeForProgram = (DateDiff("n", [DateReturn], [DateShipOut]))
On Error GoTo ErrorHandler
ctlValue = Me.Controls(ctlName).Tag
DaysOfMonth = MyArray(ctlValue - 1, 0)
DoCmd.OpenForm "frmCapsulesSchedule", acNormal, , [DateRangeForProgram] = DaysOfMonth
ExitSub:
Exit Sub
ErrorHandler:
MsgBox "DATE SHIP OUT FAILED.", , "Error!!!"
Resume ExitSub
End Sub
Please let me know if you need further information from me.
Here is the code I used for the calendar; Anywhere you see 'Teachers,' 'Schools,' or 'Capsules' would be where you'd put your own information:
Option Compare Database
Option Explicit
Private intYear As Integer
Private intMonth As Integer
Private lngFirstDayOfMonth As Long
Private intLastDayOfLastMonth As Integer
Private intFirstWeekday As Integer
Private intDaysInMonth As Integer
Private strFormReference As String
Private MyArray() As Variant
Private Sub cboMonth_Click()
On Error GoTo Errorhandler
Call Main
ExitSub:
Exit Sub
Errorhandler:
MsgBox "There has been an error. Please reload the form.", , "Error"
Resume ExitSub
End Sub
Private Sub cboYear_AfterUpdate()
On Error GoTo Errorhandler
Call Main
ExitSub:
Exit Sub
Errorhandler:
MsgBox "There has been an error. Please reload the form.", , "Error"
Resume ExitSub
End Sub
Private Sub Form_Load()
On Error GoTo Errorhandler
'Set the month and date to this current month and date
With Me
.cboMonth = Month(Date)
.cboYear = Year(Date)
End With
Call Main
ExitSub:
Exit Sub
Errorhandler:
MsgBox "There has been an error. Please reload the form.", , "Error"
Resume ExitSub
End Sub
Public Sub InitVariables()
On Error GoTo Errorhandler
intYear = Me.cboYear
intMonth = Me.cboMonth
lngFirstDayOfMonth = CLng(DateSerial(intYear, intMonth, 1))
intFirstWeekday = getFirstWeekday(lngFirstDayOfMonth)
intDaysInMonth = getDaysInMonth(lngFirstDayOfMonth)
'This is where you add the reference for the form
'It is used in case we wish to add the module to a subform
ExitSub:
Exit Sub
Errorhandler:
MsgBox "There has been an error. Please reload the form.", , "Error"
Resume ExitSub
End Sub
Public Sub Main()
On Error GoTo Errorhandler
Call InitVariables
Call InitArray
Call LoadArray
Call PrintArray
ExitSub:
Exit Sub
Errorhandler:
MsgBox "There has been an error. Please reload the form.", , "Error"
Resume ExitSub
End Sub
Public Sub InitArray()
'First column will add all dates of the array
'Second column will add visible property
'Third column will hold the string variable
Dim i As Integer
On Error GoTo Errorhandler
ReDim MyArray(0 To 41, 0 To 3)
For i = 0 To 41
MyArray(i, 0) = lngFirstDayOfMonth + 1 - intFirstWeekday + i
If Month(MyArray(i, 0)) = intMonth Then
MyArray(i, 1) = True
'This works out the days of the month
MyArray(i, 2) = i + 2 - intFirstWeekday & vbNewLine
Else
MyArray(i, 1) = False
End If
Next i
ExitSub:
Exit Sub
Errorhandler:
MsgBox "There has been an error. Please reload the form.", , "Error"
Resume ExitSub
End Sub
Public Sub LoadArray()
'This sub loads an array with the relevant variables from a query
Dim db As Database
Dim rs As Recordset
Dim rsFiltered As Recordset
Dim strQuery As String
Dim i As Integer
On Error GoTo ErrorHandler1
strQuery = "Select * FROM [qryDatesYearsCapsules2]"
Set db = CurrentDb
Set rs = db.OpenRecordset(strQuery)
With rs
If Not rs.BOF And Not rs.EOF Then
'Ensures the recordset contains records
On Error GoTo ErrorHandler2
For i = 0 To UBound(MyArray)
'Will loop through the array and use dates to filter down the query
'It firsts checks that the second column has true for its visible property
If MyArray(i, 1) = True Then
.Filter = "[NewDate]=" & MyArray(i, 0)
'To filter you must open a secondary recordset and
'Use that as the basis for a query
'This makes sense as you are building a query on a query
Set rsFiltered = .OpenRecordset
If Not rsFiltered.BOF And Not rsFiltered.EOF Then
'If the recordset is not empty then you are able
'to extract the text from the values provided
Do While Not rsFiltered.EOF = True
MyArray(i, 2) = MyArray(i, 2) & rsFiltered!CapsuleSet
' MyArray(i, 2) = MyArray(i, 2) & vbNewLine & rsFiltered!Teacher
MyArray(i, 2) = MyArray(i, 2) & vbNewLine & rsFiltered!School
' MyArray(i, 2) = MyArray(i, 2) & " - " & rsFiltered!NewDate
MyArray(i, 2) = MyArray(i, 2) & vbNewLine & vbNewLine
rsFiltered.MoveNext
Loop
End If
End If
Next i
End If
.Close
End With
ExitSub:
Set db = Nothing
Set rs = Nothing
Exit Sub
ErrorHandler1:
MsgBox "There has been an error. Please reload the form.", , "Error"
Resume ExitSub
ErrorHandler2:
MsgBox "There has been an error. Please reload the form.", , "Error"
Resume ExitSub
End Sub
Public Sub PrintArray()
Dim strTextBox As String
Dim i As Integer
On Error GoTo Errorhandler
For i = 0 To 41
strTextBox = "txt" & CStr(i + 1)
With Me
Controls(strTextBox) = ""
Controls(strTextBox).tag = i + 1
Controls(strTextBox) = MyArray(i, 2)
'Debug.Print strTextBox
'MyArray(i, 2)
End With
Next i
ExitSub:
Exit Sub
Errorhandler:
MsgBox "There has been an error. Please reload the form.", , "Error"
Resume ExitSub
End Sub
Private Sub OpenContinuousForm(ctlName As String)
Dim ctlValue As Integer
Dim DayOfMonth As Long
On Error GoTo Errorhandler
ctlValue = Me.Controls(ctlName).tag
DayOfMonth = MyArray(ctlValue - 1, 0)
DoCmd.OpenForm "frmClassDataEntry", acNormal, , "[NewDate]=" & DayOfMonth, , acDialog
ExitSub:
Exit Sub
Errorhandler:
MsgBox "There has been an error. Please reload the form.", , "Error"
Resume ExitSub
End Sub
Private Sub txt1_Click()
On Error GoTo Errorhandler
If Me.ActiveControl.Text <> "" Then
Call OpenContinuousForm(Me.ActiveControl.Name)
End If
ExitSub:
Exit Sub
Errorhandler:
MsgBox "There has been an error. Please reload form."
Resume ExitSub
End Sub
'Repeat the code for txt1_Click() all the ways to txt42_Click()
Private Sub Format()
Dim ctl As Control
Dim lngBackColor As Long
For Each ctl In Me.Detail.Controls
If DCount("*", "lstCapsules", "[Capsule]='" & ctl.Value & "'") = 0 Then
lngBackColor = 16777215
Else
lngBackColor = DLookup("Background", "lstCapsules", "[Capsule]='" & ctl.Value & "'")
End If
ctl.BackColor = lngBackColor
Next ctl
Set ctl = Nothing
End Sub
I also have a module called modFunctions:
Option Compare Database
Option Explicit
Public Function getFirstWeekday(lngFirstDayOfMonth As Long) As Integer
On Error GoTo Errorhandler
getFirstWeekday = -1
getFirstWeekday = Weekday(lngFirstDayOfMonth, vbMonday)
ExitFunction:
Exit Function
Errorhandler:
getFirstWeekday = 0
MsgBox "There has been an error. Please reload the form.", , "Error"
Resume ExitFunction
End Function
Public Function getDaysInMonth(lngFirstDayOfMonth As Long) As Integer
On Error GoTo Errorhandler
getDaysInMonth = -1
getDaysInMonth = DateDiff("d", lngFirstDayOfMonth, DateAdd("m", 1, lngFirstDayOfMonth))
ExitFunction:
Exit Function
Errorhandler:
getDaysInMonth = 0
MsgBox "Something is wrong with the DATES!.", , "Date Error"
Resume ExitFunction
End Function
There is a very useful youtube video I came across by Access All In One. Here is a link to the database used in the example
Your syntax in the Where condition of the openform command is incorrect.
It should be "[DateRangeForProgram]=" & DaysOfMonth, if the field your using to filter the form's recordsource is [DateRangeForProgram].
Also, if you're trying to open the form to multiple days, you should likely be using the Between operator. The datediff function's first argument specifies an interval, and your interval is minutes.
You should post the rest of the code so the entire scenario is clear.
I have a command button tied to a query called "GenderCount". The results appear in a subtable when I click the button. I need the results to appear in a text box on my form (Text26). Here is my code--thanks in advance for any suggestions:
Private Sub Command21_Click()
On Error GoTo Err_Command21_Click
Dim stDocName As String
stDocName = "GenderCount"
DoCmd.OpenQuery stDocName, acNormal, acEdit
Exit_Command21_Click:
Exit Sub
Err_Command21_Click:
MsgBox Err.Description
Resume Exit_Command21_Click
End Sub
This what you need
Private Sub Command21_Click()
On Error GoTo Err_Command21_Click
me.txtField1 = dlookup("CountOfGender","GenderCount","Gender = M")
me.txtField1 = dlookup("CountOfGender","GenderCount","Gender = F")
Exit_Command21_Click:
Exit Sub
Err_Command21_Click:
MsgBox Err.Description
Resume Exit_Command21_Click
End Sub