Runtime Error 13 Type Mismatch (1 Viewer)

[coolcatkelso]

Hiya

Trying to use a Calendar Entry form that I got from the internet into my DB. Tried the original example and used my own data and it worked. But when I copied it all into my main DB I get the runtime error 13 - type mismatch although nothing has been changed. The code bringing up the error is -

StrgSQL = "SELECT * FROM tblInput WHERE UserID=" & CLng(Me.cboUser.Column(0)) & _
" AND (Format([InputDate], 'm')=" & Me.CalMonth & _
" AND Format([InputDate],'yyyy')=" & Me.CalYear & ");"
Set rst = CurrentDb.OpenRecordset(StrgSQL, dbOpenDynaset)
Mainly the last line " Set rst = CurrentDb.OpenRecordset(StrgSQL, dbOpenDynaset)" is where the debug is finding faults


The full code is

Option Compare Database
Option Explicit
Private Sub cboDepartment_AfterUpdate()
Me.cboUser = Null
Me.cboUser.Enabled = True
Me.MonthPrevBut.Enabled = False
Me.MonthNextBut.Enabled = False
Me.YearPrevBut.Enabled = False
Me.YearNextBut.Enabled = False
Me.CalMonth.Enabled = False
Me.CalYear.Enabled = False
Me.cmdMonthToday.Enabled = False
Me.cmdYearToday.Enabled = False
Me.cmdToday.Enabled = False
Me.cboUser.Requery
End Sub
Private Sub cboDepartment_GotFocus()
Call Form_Load
Me.Requery
End Sub
Private Sub cboUser_AfterUpdate()
If IsNull(Me.cboUser) Then Exit Sub
Me.Caption = " Schedule for " & Me.cboUser.Column(1) & _
" Department" & " - " & Me.cboDepartment.Column(1)
Me.MonthPrevBut.Enabled = True
Me.MonthNextBut.Enabled = True
Me.YearPrevBut.Enabled = True
Me.YearNextBut.Enabled = True
Me.CalMonth.Enabled = True
Me.CalYear.Enabled = True
Me.cmdMonthToday.Enabled = True
Me.cmdYearToday.Enabled = True
Me.cmdToday.Enabled = True

Call Cal([CalMonth], [CalYear], Me.cboUser)
End Sub
Private Sub cboUser_Click()
If IsNull(Me.cboUser) = False Then Call SetCalendar
End Sub
Private Sub cmdToday_Click()
Me![CalYear] = DatePart("yyyy", Now())
Me![CalMonth] = DatePart("m", Now())

Call Cal([CalMonth], [CalYear], Me.cboUser)

If IsNull(Me.cboUser) = False Then Call SetCalendar
End Sub
Private Sub cmdYearToday_Click()
Me![CalYear] = DatePart("yyyy", Now())

Call Cal([CalMonth], [CalYear], Me.cboUser)

If IsNull(Me.cboUser) = False Then Call SetCalendar
End Sub
Private Sub ExitBut_Click()
DoCmd.Close acForm, "frmCalendar"
End Sub
Private Sub Form_Current()
If IsNull(Me.cboUser) = False Then Call SetCalendar
End Sub
Private Sub Form_Load()
Dim i As Integer, j As Integer
Dim mycontrol As Control
Dim strYear As String, nextYear As String
Dim f As Form
Dim mynum

Set f = Forms!frmCalendar

For i = 1 To 37
Me.Controls("Text" & i).Visible = False
Me.Controls("Day" & i).Visible = False
Next

'Set mycontrol = Me.CalYear
j = 1990

strYear = j

For i = 1 To 60
nextYear = j + i
strYear = strYear & ";" & nextYear
'Me.CalYear.AddItem j + i
Next i

Me.CalYear.RowSource = strYear
Me.CalMonth = Format(Now, "m")
Me.CalYear = Format(Now, "yyyy")
'Call Cal([CalMonth], [CalYear], Me.cboUser)

End Sub
Private Sub Form_Open(Cancel As Integer)
'*********************************************
'* Disables/Enables the menu bar *
'*********************************************
Application.CommandBars("Menu bar").Enabled = False '*****Disables Menu Bar******
'Application.CommandBars("Menu bar").Enabled = True '*****Enables Menu Bar*******

Caption = "Welcome " & Me.Text_Network_User

DoCmd.MoveSize , 800 'Moves Calendar down on screen

'Set the Conditional Formating for all
'the Day Number boxes in Form. Keep in
'mind...this will supercede and other
'changes to the DayBoxes so it is not
'used but instead is just here so you
'can see how Conditional Formatting can
'be set up progmaticly.
' Call SetDaysCondFormating
End Sub
Private Sub Form_Timer()
'Update the Date/Time display
Me!lblClock.Caption = Format(Now, "dddd, mmm d yyyy, hh:mm:ss AMPM")
'Flash the Summary label
Me.ArrowLabel.Visible = Not Me.ArrowLabel.Visible ' blinking label
End Sub
Private Sub CalMonth_Click()
Call Cal([CalMonth], [CalYear], Me.cboUser)
If IsNull(Me.cboUser) = False Then Call SetCalendar
End Sub
Private Sub MonthNextBut_Click()
If Me.CalMonth < 12 Then
Me!CalMonth = Me!CalMonth.Column(0) + 1
Else
Me!CalMonth = 1
Me!CalYear = Me!CalYear + 1
End If
Call Cal([CalMonth], [CalYear], Me.cboUser)
If IsNull(Me.cboUser) = False Then Call SetCalendar
End Sub
Private Sub MonthPrevBut_Click()
If Me!CalMonth > 1 Then
Me!CalMonth = Me!CalMonth.Column(0) - 1
Else
Me!CalMonth = 12
Me!CalYear = Me!CalYear - 1
End If
Call Cal([CalMonth], [CalYear], Me.cboUser)
If IsNull(Me.cboUser) = False Then Call SetCalendar
End Sub
Private Sub Print_Click()
On Error GoTo Err_Print_Click

If Me.cboDepartment.ListIndex = "-1" Then
MsgBox "You must make sure yor criteria's" & Chr(13) & _
"are selected in before proceeding." & Chr(13) & _
"" & Chr(13) & _
" - Please select a Department" & Chr(13) & _
" - Please select an Employee", vbCritical, "Selection Error"
Me.cboDepartment.SetFocus
Exit Sub
End If
If Me.cboUser.ListIndex = "-1" Then
MsgBox "You must make sure yor criteria's" & Chr(13) & _
"are selected in before proceeding." & Chr(13) & _
"" & Chr(13) & _
" - Please select a Department" & Chr(13) & _
" - Please select an Employee", vbCritical, "Selection Error"

Me.cboUser.SetFocus
Exit Sub
Else
DoCmd.OpenForm "frmReportSelection", , , , , acDialog
End If

Exit_Print_Click:
Exit Sub
Err_Print_Click:
MsgBox Err.Description
Resume Exit_Print_Click:
End Sub
Private Sub cmdEmployeeStatusChange_Click()
On Error GoTo Err_cmdEmployeeStatusChange_Click
DoCmd.OpenForm "frmPasswordRequired", , , , , acDialog

DoCmd.Close acForm, "frmCalendar"


Exit_cmdEmployeeStatusChange_Click:
Exit Sub
Err_cmdEmployeeStatusChange_Click:
MsgBox Err.Description
Resume Exit_cmdEmployeeStatusChange_Click
End Sub
Private Sub cmdMonthToday_Click()
Me![CalMonth] = DatePart("m", Now())

Call Cal([CalMonth], [CalYear], Me.cboUser)

If IsNull(Me.cboUser) = False Then Call SetCalendar
End Sub
Private Sub SetDaysCondFormating()
Dim DayObj As FormatCondition
Dim i As Integer
Dim iRed As Integer
Dim iGreen As Integer
Dim iBlue As Integer

'Remove any existing format conditions.
For i = 1 To 37: Me.Controls("Day" & i).FormatConditions.Delete: Next i
' Create a format object and add it to the FormatConditions collection.
' We have to pass to pass a value to the function otherwise
' Access will only execute the function once.
' Also due to a bug we must programmatically setup the
' Conditional Formatting here. Otherwise if you were to setup
' CF via the GUI the state of the Disabled property
' is not respected. This will allow our Background TextBox control
' to receive the focus and be activated - something we don't want!!
For i = 1 To 37
Set DayObj = Me.Controls("Day" & i).FormatConditions.Add(acExpression, _
, "Format(Now(),""d"")=[Day" & i & "]")
'Setup our props
With Me.Controls("Day" & i).FormatConditions(0)
Call ColorCodeToRGB(16777166, iRed, iGreen, iBlue)
.BackColor = RGB(iRed, iGreen, iBlue) '16777166 'very light Cyan

.FontBold = True

Call ColorCodeToRGB(vbBlue, iRed, iGreen, iBlue)
.ForeColor = RGB(iRed, iGreen, iBlue) 'Blue
End With
Next i
Set DayObj = Nothing
End Sub

Public Sub SetCalendar()
Dim rst As Recordset, StrgSQL As String
Dim OnDay As Integer, CurDay As Integer, Bclr As Long, Fclr As Long
Dim iRed As Integer, iGreen As Integer, iBlue As Integer
Dim i As Integer, AbsentReason As String

'Hold what Day it is (the day number)
CurDay = Format(Now(), "d")

'Clear the Day Boxes and set the Current Day Box Color
'but only if the current day is visible.
For i = 1 To 37
Me.Controls("Day" & i).BackColor = vbWhite
Me.Controls("Day" & i).ForeColor = vbBlue
Me.Controls("DBox" & i).BackColor = -2147483633 ' system back color
Me.Controls("Text" & i) = Null
If Me.Controls("Day" & i) = CurDay And _
Me.Controls("Day" & i).Visible = True Then
'Color in the Box to indicate "Today" but only
'if the calendar is on todays month.
If Me.CalMonth.Column(1) = Format(Now, "mmmm") Then
Me.Controls("DBox" & i).BackColor = 16777166 'light Cyan
End If
End If
Next i

StrgSQL = "SELECT * FROM tblInput WHERE UserID=" & CLng(Me.cboUser.Column(0)) & _
" AND (Format([InputDate], 'm')=" & Me.CalMonth & _
" AND Format([InputDate],'yyyy')=" & Me.CalYear & ");"
Set rst = CurrentDb.OpenRecordset(StrgSQL, dbOpenDynaset)

If rst.RecordCount = 0 Then GoTo Exit_SetCalendar

With rst
.MoveLast: .MoveFirst
Do Until .EOF
OnDay = Format(!InputDate, "dd")
AbsentReason = Nz(!InputText, "")
Select Case !InputText
Case "Vacation"
Bclr = 438366: Fclr = 0
Case "Personal Holiday"
Bclr = 16711680: Fclr = 16777215
Case "Unworked Holidays"
Bclr = 16633344: Fclr = 0
Case "Excused Tardy"
Bclr = 8421504: Fclr = 16777215
Case "Excused Absence"
Bclr = 65535: Fclr = 0
Case "Worked Holiday"
Bclr = 16777164: Fclr = 0
Case "Unexcused Absence"
Bclr = 255: Fclr = 16777215
Case "Unexcused Tardy"
Bclr = 16711935: Fclr = 16777215
Case "Excused Leave Early"
Bclr = 65535: Fclr = 0
Case "Plant Closed"
Bclr = 26367: Fclr = 16777215
Case "Disciplinary Lay Off"
Bclr = 16776960: Fclr = 0
Case "Medical Leave"
Bclr = 128: Fclr = 16777215
Case "Family Leave"
Bclr = 65280: Fclr = 0
Case "Personal Leave"
Bclr = 10092543: Fclr = 0
Case "Jury Duty"
Bclr = 52479: Fclr = 0
Case "Funeral Leave"
Bclr = 13408767: Fclr = 0
End Select
For i = 1 To 37
If Me.Controls("Day" & i).Value = OnDay Then
Me.Controls("Day" & i).BackColor = Bclr
Me.Controls("Day" & i).ForeColor = Fclr
Me.Controls("Text" & i) = AbsentReason
End If
Next i
Bclr = vbWhite: Fclr = vbBlue: AbsentReason = ""
.MoveNext
Loop
End With
Exit_SetCalendar:
rst.Close
Set rst = Nothing
End Sub
Private Sub CalYear_Click()
Call Cal([CalMonth], [CalYear], Me.cboUser)
If IsNull(Me.cboUser) = False Then Call SetCalendar
End Sub
Private Sub YearNextBut_Click()
Me.CalYear = Me.CalYear + 1
Call Cal([CalMonth], [CalYear], Me.cboUser)
If IsNull(Me.cboUser) = False Then Call SetCalendar
End Sub
Private Sub YearPrevBut_Click()
Me.CalYear = Me.CalYear - 1
Call Cal([CalMonth], [CalYear], Me.cboUser)
If IsNull(Me.cboUser) = False Then Call SetCalendar
End Sub
Private Function ShowReport(ByVal RName As String)
If Me.cboDepartment.ListIndex = "-1" Then
MsgBox "You must make sure yor criteria's" & Chr(13) & _
"are selected in before proceeding." & Chr(13) & _
"" & Chr(13) & _
" - Please select a Department" & Chr(13) & _
" - Please select an Employee", vbCritical, "Selection Error"
Me.cboDepartment.SetFocus
Exit Function
End If

If Me.cboUser.ListIndex = "-1" Then
MsgBox "You must make sure yor criteria's" & Chr(13) & _
"are selected in before proceeding." & Chr(13) & _
"" & Chr(13) & _
" - Please select a Department" & Chr(13) & _
" - Please select an Employee", vbCritical, "Selection Error"
Me.cboUser.SetFocus
Exit Function
Else
DoCmd.OpenReport RName, acPreview
End If
End Function

I will include the DB if anyone needs a closer look.

What I want to do is be able to select the customer from a combo box, and a staff member from another combo box and enter a date in the calander for work to commence. The example I got is good so would like to stick with it if I can figure out why I get the error
________
ALASKA MEDICAL MARIJUANA

 

[JANR]

It could be a library refrence ambiguety. In Access recordsets are used both in DAO and ADO check your library settings and perhaps remove the ambiguety and declare your recordsets more clearly.

Dim rst as DAO.recordset .... If you use DAO the make sure that DAO is checked in your library refrence

JR

 

[coolcatkelso]

Hiya

I checked the Db that I want to add in and your right, the library has one different referance The DB I want to have has Microsoft DAO

My own Db doesn't. If I try to add it I get the error message

Name conflicts with existing module, project, or object library
Modules, object libraries, and referenced projects must be uniquely named within a project. This error has the following causes and solutions:

• There is already a module, project, or object library with this name referenced in this project. A file name extension isn't considered part of the name, so different extensions can't be used to distinguish one file from another. Use a different name for one of the duplicate module, project, or object library references.
• You attempted to add a reference to a project or object library whose file name (without an extension) is the same as the name of one of the current project's modules. Change either the module name or the name of the file that could not be added.
  

Not sure where to go from here tho?
________
SHEMALE WEBCAM