Help with Runtime Error 3075

[kellielewis2872]

Can someone help me with my Runtime Error 3075? I have attached a copy of my database. I am trying to make a calendar form with the list boxes having two columns. It works fine with the strFieldID and strFieldName but when I try adding the strDone I run into the error.

Thanks in advance for any help.

 

[pr2-eugin]

Hello kellielewis2872, unfortunately I am not on my PC.. So cannot view your file.. So if you could explain what is that you are trying to do, and show us some coding along with the Error Description, we might be able to help.. Or wait for a while someone should be along to help you..

It would be great if you could make your DB available in a older version (probably an mdb) might be helpful as not many of us on here have A2010.. Good Luck..

 

[Cronk]

Geez, you've got to help people help you. 10 forms and no guide how to replicate the problem.

 

[kellielewis2872]

Thank you for responding pr2-eugin.

What I am trying to do is make a calendar form. It has text boxes named text0 to text 41 and list boxes name list0 to list41. The text boxes hold the days of the month and the list boxes will hold the information of the things scheduled for that day. I want my list boxes to have two columns. I have a table named tblCalendarSettings which holds the information of what table to holds the information of what table to look at to get the information for the calendar and what fields to look at which I want it to look at the table tblSchedule and the fields ID, Done, and EventDescription. I have data in tblCalendarSettings and in tblSchedule.

Here is the code I have to assign values:

Functions AssignValues()

Dim db As Database
Dim rs As Recordset
Dim STRSQL As String
Dim strDone As String
Dim strField As String
Dim strSource As String
Dim strDateField As String
Dim strForm As String
Dim strFieldID As String
Dim strFormDateName As String
Dim fDateFilter As Boolean
Dim strNewForm As String
Dim strNewDateName As String
Dim fNewOption As Boolean

If IsNull(OpenArgs) Then
intSetting = Me.textsettingid
Else
intSetting = OpenArgs
Me.textsetting = OpenArgs
Me.testsettingis = intSetting
EndIf

STRSQL = "SELECT " FROM tbleCaledarSettings where ([SettingID] = " & intSetting & ")"

Set db = Current Db()
Set rs = db.OpenRecordset(STRSQL)

With rs

If Not (.BOF and .EOF) Then
strField = !FieldName
strSource = !SourceName
strDateField = !DateFieldName
strForm = !FormName
strDone = !FieldOther
strFieldID = !FieldIDName
strFormDateName = !FormDateName
fDateFilter = !UseDateFilter
strNewForm = !NewFormName
strNewDateName = !NewFormDateName
fNewOption = !IncludeNewOption

Else

MsgBox "Calendar setting ID " & intSetting & " needs to set up before opening the calendar.",,"Setting ID " & intSetting & " Doesn't Exist"

GoTo Calendar_Close

End If

End With


Set rs = Nothing: Set db = Nothing

Call SetLists

Call SetFirstPos

intTodayPos = int(Format(Date, "dd")) + int((7- Format(fcalendarday(Format(date,"mm"), Format(Date, "yyyy"), "dd")))

Call calendarrefreshing

Exit_Sub


Exit Function

Calendar_Close

DoCmd.Close

Exit Function

End Funtion



Here is the code I have for filling the calendar and the code I get an error on for the STRSQL Line:


Private Sub fillcalendar()

ReDim griddate(0 to 41)
Dim i As Interger
Dim STRSQL As String
Dim db As Database
Dim rs As Recordset
Dim fEmpty As Boolean
Dim strUnionSQL As String
Dim strRowSource As String
Dim strDone As String

STRSQL = "SELECT " & strSource & "." & strField & ", " & strSource & "." & strDone & ", " & strSouce & "." & strField & " FR
OM " & strSource

Set db = CurrentDb()
Set rs = db.OpenRecordset(STRSQL)

If fNewOption Then
strUnionSQL = " UNION SELECT " & Chr(34) & Chr(34) & " AS " & strFieldID & ", " & Chr(34) & "No" & Chr(34) & " AS " & strDone & ", " & Chr(34) & "New" & Chr(34) & " AS " & strField & " FR
OM " & strSource

Else

strUnionSQL = ""

End If

griddate(0) = fcalendarday([Combomonth],[Comboyear],1,1)
Me.Text0.Value = Int(Formate(griddate(0),"dd"))
Me.List0.ColumnCount = 3
Me.List0.ColumnWidths = "0;0.5;1"
fEmpty = (rs.BOF and rs.EOF)

If fEmpty Then
strRowSource = Mid(Nz(strUnionSQL, "1234567"), 8)

Else

strRowSouce = "SELECT " & strSource & "." & strFieldID & ", " & strSource & "." & strDone & ", " & strSource "." & strField & " FROM " & STRsOURCE & _
" WHERE(((" & strSource & "." strDateField & ")= #" & Format(griddate(0), "mm/dd/yyyy") & "#))"& _
strUnionSQL

End If

Me.List0.RowSource = strRowSource
For i = 1 to 41
griddate(i) = DateAdd("d",i,griddate(0))
Controls("text" & i).Value = Int(Format(gridddate(i),"dd"))

If fEmpty Then
strRowSource = Mid(Nz(strUnionSQL, "1234567 "), 8)

Else

strRowSouce = "SELECT " & strSource & "." & strFieldID & ", " & strSource & "." & strDone & ", " & strSource "." & strField & " FROM " & STRsOURCE & _
" WHERE(((" & strSource & "." strDateField & ")= #" & Format(griddate(i), "mm/dd/yyyy") & "#))"& _
strUnionSQL


End If

Controls("list" & i).RowSource = strRowSource

Next i

End Sub


The following code will work for 1 column:

Private Sub fillcalendar()

ReDim griddate(0 to 41)
Dim i As Interger
Dim STRSQL As String
Dim db As Database
Dim rs As Recordset
Dim fEmpty As Boolean
Dim strUnionSQL As String
Dim strRowSource As String

STRSQL = "SELECT " & strSource & "." & strField & ", " & strSouce & "." & strField & " FR
OM " & strSource

Set db = CurrentDb()
Set rs = db.OpenRecordset(STRSQL)

If fNewOption Then
strUnionSQL = " UNION SELECT " & Chr(34) & Chr(34) & " AS " & strFieldID & ", " & Chr(34) & "New" & Chr(34) & " AS " & strField & " FR
OM " & strSource

Else

strUnionSQL = ""

End If

griddate(0) = fcalendarday([Combomonth],[Comboyear],1,1)
Me.Text0.Value = Int(Formate(griddate(0),"dd"))
Me.List0.ColumnCount = 2
Me.List0.ColumnWidths = "0;1"
fEmpty = (rs.BOF and rs.EOF)

If fEmpty Then
strRowSource = Mid(Nz(strUnionSQL, "1234567"), 8)

Else

strRowSouce = "SELECT " & strSource & "." & strFieldID & ", " & strSource "." & strField & " FROM " & STRsOURCE & _
" WHERE(((" & strSource & "." strDateField & ")= #" & Format(griddate(0), "mm/dd/yyyy") & "#))"& _
strUnionSQL

End If

Me.List0.RowSource = strRowSource
For i = 1 to 41
griddate(i) = DateAdd("d",i,griddate(0))
Controls("text" & i).Value = Int(Format(gridddate(i),"dd"))

If fEmpty Then
strRowSource = Mid(Nz(strUnionSQL, "1234567 "), 8)

Else

strRowSouce = "SELECT " & strSource & "." & strFieldID & ", " & strSource "." & strField & " FROM " & STRsOURCE & _
" WHERE(((" & strSource & "." strDateField & ")= #" & Format(griddate(i), "mm/dd/yyyy") & "#))"& _
strUnionSQL


End If

Controls("list" & i).RowSource = strRowSource

Next i

End Sub


Thank you in advance to any help you may be able to give me.

 

[kellielewis2872]

Cronk,

The form with the issue is frmCalendar.

Thank you for any assistance you can give me.

 

[Cronk]

Kellie

When I open your database, I get an error which says missing operator.

I clicked Debug and the line Set rs = db.OpenRecordset(STRSQL) is highlighted. So what is in strSQL?

I pressed Control + G to bring up the Immediate window and typed
? strSQL

The contents of strSQL are
SELECT tblSchedule.ID, tblSchedule., tblSchedule.EventDescription FROM tblSchedule

Missing second field.

strDone is a zero length string.

Why, because you've declared strDone not only at the module level (before the first function/sub in the module), but also in the function where the error is occurring, as well as the function where it is initially assigned. (Incidentally, good to see you have the explicit declaration of variables ie Option Explicit at the start of the module.)

When you declare a variable with same name in the function, VBA treats this differently to a module variable.

So in AssignValues(), strDone is set equal to "Done" but as soon as you leave the sub routine, the local variable goes out of scope and the module level variable still has nothing in it.

To fix this problem, remove all instances of Dim strDone as string, except the first one at the top.

NB I notice also you have a compile error which might cause other problems. (In the code window, select Debug | Compile

 

[kellielewis2872]

Thank you so much Cronk. That fixed my issue and I found and fixed the other issue you brought to my attention.