Form getting 3048 error when repeated

[Ruegen]

I have this to open form and change the look of the report for pdf however if I have it loop I eventually can't "create more databases" and I get an error



not sure how to fix

Private Sub Report_Close()
Set db = Nothing
End Sub


Private Sub Report_Load()
Me.Caption = Replace(Replace(Replace(Replace(Me.boxArea, " ", ""), "/", ""), ",", ""), ".", "")






Dim strFilter As String
Dim rs As DAO.Recordset
Dim strSQL As String






strFilter = Me.Report.Filter
strSQL = "SELECT * FROM qrySheets" & " WHERE((((tblShowTour.TypeID)=" & TypeIDOpenForm & ") And ((tblShowTour.AreasID)=" & AreaIDOpenForm & ") And ((tblShowTour.YearID)=" & YearIDOpenForm & ")))"
Debug.Print strSQL
Set db = CurrentDb








'Debug.Print strSQL
Set rs = db.OpenRecordset(strSQL)


'change the heights on the reports
If rs.RecordCount < 30 Then
Me.ReportHeader.Height = 979
Me.GroupHeader0.Height = 800
Me.GroupHeader1.Height = 473
Me.Term1.Top = 300
Me.Text61.Top = 313






Else


Me.ReportHeader.Height = 313
Me.GroupHeader0.Height = 300
Me.GroupHeader1.Height = 273
Me.Term1.Top = 0
Me.Text61.Top = 0






End If




rs.Close
Set rs = Nothing
strSQL = ""
'db.Close




End Sub

Note: title of this post not correct - it is the report that is giving me the error.

[burrina]

How many queries are open with this Report? Access has an internal limit of 255 simultaneous connections to Jet. A “connection” includes things like combo boxes, recordsets, queries, etc…. Maybe a place to start looking anyway. Complex queries are also generally a culprit.


HTH

[Ruegen]

There's like one form open with 5 combo boxes. Then the code loops through each row in each combo to affect change in the code ( me.combobox.column(0))

There is one function that opens a report for each area/row in a combo box, filters the report to the same value and then exports it as a PDF.

What I don't understand is why the code works on a single use but because it is repeating the task I get the problem :-/

Fair enough if I am making several instances of a query some how but I don't see that happening. I am closing the variable (rs) each time the form runs in the task.

[Ruegen]

Also the query is not all that complex...

[ItsMe]

I do not see any looping. If the lop is causing the problem, it may be helpful to see how it is applied. Also, what does it mean to "create more databases" ???

[Ruegen]

Function makeHTMLPDF(controlYear As control, controlType As control, controlState As control, controlArea As control, frm1 As String)






Dim strWebsiteYear As String, strWebsiteState As String, strWebsiteType As String
strWebsiteYear = controlYear.Column(1)
strWebsiteType = controlType.Column(2)


Dim i As Integer


For i = 0 To controlState.ListCount - 1
controlState = controlState.Column(0, i)
controlArea.Requery


    Dim strSQL As String


    Dim intComboItem As Integer
    Dim mypdfpath As String, strStateShort As String
    For intComboItem = 0 To controlArea.ListCount - 1
       
    strStateShort = controlState.Column(1)
    If strStateShort = "ACT" Then
    strStateShort = "NSW"
    End If
    




strSQL = "SELECT tblShows.ID, tblShows.ShowName, tblShows.Blurb, tblShowTour.DateTouringFrom, tblShowTour.DateTouringUntil, tblShowTour.TypeID, tblShowTour.AreasID, tblShowTour.YearID " & vbCrLf & _
"FROM tblYear INNER JOIN (tblType INNER JOIN (tblTerms INNER JOIN (tblStates INNER JOIN (tblShows INNER JOIN (tblAreas INNER JOIN tblShowTour ON tblAreas.ID = tblShowTour.AreasID) ON tblShows.ID = tblShowTour.ShowsID) ON tblStates.ID = tblAreas.StatesID) ON tblTerms.ID = tblShowTour.TermsID) ON tblType.ID = tblShowTour.TypeID) ON tblYear.ID = tblShowTour.YearID " & vbCrLf & _
"WHERE (((tblShowTour.TypeID)=[Forms]![frmMakeToHtml]![cboType]) AND ((tblShowTour.AreasID)=" & controlArea.ItemData(intComboItem) & ") AND ((tblShowTour.YearID)=[forms]![frmMakeToHtml]![CboYear]));"


    
    
'makes a temp folder
 If Dir("C:\" & strWebsiteYear & "_SPT_WEBSITE\Tour_" & strWebsiteType & "\PDF_" & strStateShort & "\", vbDirectory) = "" Then
        MkDir ("C:\" & strWebsiteYear & "_SPT_WEBSITE\Tour_" & strWebsiteType & "\PDF_" & strStateShort & "\")
    End If


'Debug.Print controlArea.ItemData(intComboItem)


controlArea = controlArea.ItemData(intComboItem)


If controlArea.Column(5) = True Then
'Debug.Print "skipped PDF for " & controlArea.Column(1)


Else




YearIDOpenForm = controlYear.Column(0)
TypeIDOpenForm = controlType.Column(0)
AreaIDOpenForm = controlArea.Column(0)


DoCmd.OpenReport "rptPrintOut", acViewReport, strSQL, ""
DoCmd.SelectObject acReport, "rptPrintOut"


If Reports("rptPrintOut").Report.txtCount < 40 Then


Reports("rptPrintOut").Report.ReportHeader.Height = 979
Reports("rptPrintOut").Report.GroupHeader0.Height = 800
Reports("rptPrintOut").Report.GroupHeader1.Height = 473
Reports("rptPrintOut").Report.Term1.Top = 300
Reports("rptPrintOut").Report.Text61.Top = 313


Else


Reports("rptPrintOut").Report.ReportHeader.Height = 313
Reports("rptPrintOut").Report.GroupHeader0.Height = 300
Reports("rptPrintOut").Report.GroupHeader1.Height = 273
Reports("rptPrintOut").Report.Term1.Top = 0
Reports("rptPrintOut").Report.Text61.Top = 0


End If


mypdfpath = "C:\" & strWebsiteYear & "_SPT_WEBSITE\Tour_" & strWebsiteType & "\PDF_" & strStateShort & "\" & Nz(Reports!rptPrintOut.Caption, "EDIT") & ".pdf"
DoCmd.OutputTo acOutputReport, "", acFormatPDF, mypdfpath, False
DoCmd.Close acReport, "rptPrintOut"




End If
        
        
    Next


Next




End Function

[Ruegen]

I do not see any looping. If the lop is causing the problem, it may be helpful to see how it is applied. Also, what does it mean to "create more databases" ???

The entire function minus what I did to the report (I removed making a recordset and put the code into the function instead this time) - same error. It is when it exports out to PDF.

[Ruegen]

I cleaned up the code and marked out the changes to the PDF however I still get the error on line: DoCmd.OutputTo acOutputReport, "", acFormatPDF, mypdfpath, False

Function makeHTMLPDF(controlYear As Control, controlType As Control, controlState As Control, controlArea As Control, frm1 As String)


'*** 8 is ACT - as this has no area it will not need a pdf and use the NSW one


For i = 0 To controlState.ListCount - 1


controlState = controlState.Column(0, i)








If controlState.Column(0) <> 8 Then
Debug.Print controlState.Column(1) & " keep "
controlArea.Requery


For a = 0 To controlArea.ListCount - 1


controlArea = controlArea.Column(0, a)
strSQL = "SELECT tblShows.ID, tblShows.ShowName, tblShows.Blurb, tblShowTour.DateTouringFrom, tblShowTour.DateTouringUntil, tblShowTour.TypeID, tblShowTour.AreasID, tblShowTour.YearID " & vbCrLf & _
"FROM tblYear INNER JOIN (tblType INNER JOIN (tblTerms INNER JOIN (tblStates INNER JOIN (tblShows INNER JOIN (tblAreas INNER JOIN tblShowTour ON tblAreas.ID = tblShowTour.AreasID) ON tblShows.ID = tblShowTour.ShowsID) ON tblStates.ID = tblAreas.StatesID) ON tblTerms.ID = tblShowTour.TermsID) ON tblType.ID = tblShowTour.TypeID) ON tblYear.ID = tblShowTour.YearID " & vbCrLf & _
"WHERE (((tblShowTour.TypeID)=" & controlType.Column(0) & ") AND ((tblShowTour.AreasID)=" & controlArea.Column(0) & ") AND ((tblShowTour.YearID)=" & controlYear.Column(0) & "));"








If controlArea.Column(5) = True Then
'Debug.Print "skipped PDF for " & controlArea.Column(1)




Else




 If Dir("C:\" & controlYear.Column(1) & "_SPT_WEBSITE\Tour_" & controlType.Column(2) & "\PDF_" & IIf(controlState.Column(0) = 8, "NSW", controlState.Column(1)) & "\", vbDirectory) = "" Then
        MkDir ("C:\" & controlYear.Column(1) & "_SPT_WEBSITE\Tour_" & controlType.Column(2) & "\PDF_" & controlState.Column(1) & "\")
    End If






DoCmd.OpenReport "rptPrintOut", acViewReport, strSQL, ""
DoCmd.SelectObject acReport, "rptPrintOut"




If Reports("rptPrintOut").Report.txtCount < 40 Then




'Reports("rptPrintOut").Report.ReportHeader.Height = 979
'Reports("rptPrintOut").Report.GroupHeader0.Height = 800
'Reports("rptPrintOut").Report.GroupHeader1.Height = 473
'Reports("rptPrintOut").Report.Term1.Top = 300
'Reports("rptPrintOut").Report.Text61.Top = 313




Else




'Reports("rptPrintOut").Report.ReportHeader.Height = 313
'Reports("rptPrintOut").Report.GroupHeader0.Height = 300
'Reports("rptPrintOut").Report.GroupHeader1.Height = 273
'Reports("rptPrintOut").Report.Term1.Top = 0
'Reports("rptPrintOut").Report.Text61.Top = 0




End If




mypdfpath = "C:\" & controlYear.Column(1) & "_SPT_WEBSITE\Tour_" & controlType.Column(2) & "\PDF_" & IIf(controlState.Column(0) = 8, "NSW", controlState.Column(1)) & "\" & Nz(Reports!rptPrintOut.Caption, "EDIT") & ".pdf"
DoCmd.OutputTo acOutputReport, "", acFormatPDF, mypdfpath, False
DoCmd.Close acReport, "rptPrintOut"






End If




Next


End If




Next


























End Function

[Ruegen]

My Problem seems to be when I load the report each after another - for some reason it won't close the recordsource of the reports so I keep loading more??

[Ruegen]

Nevermind I fixed it with this - although I have no idea how

there was some lines that I replaced in blue that changed how this worked

Function makeHTMLPDF(controlYear As Control, controlType As Control, controlState As Control, controlArea As Control, frm1 As String)


'*** 8 is ACT - as this has no area it will not need a pdf and use the NSW one


For i = 0 To controlState.ListCount - 1


controlState = controlState.Column(0, i)








If controlState.Column(0) <> 8 Then
Debug.Print controlState.Column(1) & " keep "
controlArea.Requery


For a = 0 To controlArea.ListCount - 1


controlArea = controlArea.Column(0, a)




strSQL = "TypeID=" & controlType.Column(0) & " AND AreasID =" & controlArea.Column(0) & " AND YearID=" & controlYear.Column(0)
Debug.Print strSQL






If controlArea.Column(5) = True Then
'Debug.Print "skipped PDF for " & controlArea.Column(1)




Else




 If Dir("C:\" & controlYear.Column(1) & "_SPT_WEBSITE\Tour_" & controlType.Column(2) & "\PDF_" & IIf(controlState.Column(0) = 8, "NSW", controlState.Column(1)) & "\", vbDirectory) = "" Then
        MkDir ("C:\" & controlYear.Column(1) & "_SPT_WEBSITE\Tour_" & controlType.Column(2) & "\PDF_" & controlState.Column(1) & "\")
    End If


Debug.Print controlType.Column(0) & " The type"
Debug.Print controlArea.Column(0) & " The area"
Debug.Print controlYear.Column(0) & " The year"


DoCmd.OpenReport "rptPrintOut", acViewPreview, , strSQL, acNormal
DoCmd.SelectObject acReport, "rptPrintOut"




If Reports("rptPrintOut").Report.txtCount < 40 Then




Reports("rptPrintOut").Report.ReportHeader.Height = 979
Reports("rptPrintOut").Report.GroupHeader0.Height = 800
Reports("rptPrintOut").Report.GroupHeader1.Height = 473
Reports("rptPrintOut").Report.Term1.Top = 300
Reports("rptPrintOut").Report.Text61.Top = 313




Else




Reports("rptPrintOut").Report.ReportHeader.Height = 313
Reports("rptPrintOut").Report.GroupHeader0.Height = 300
Reports("rptPrintOut").Report.GroupHeader1.Height = 273
Reports("rptPrintOut").Report.Term1.Top = 0
Reports("rptPrintOut").Report.Text61.Top = 0




End If










mypdfpath = "C:\" & controlYear.Column(1) & "_SPT_WEBSITE\Tour_" & controlType.Column(2) & "\PDF_" & controlState.Column(1) & "\" & Reports!rptPrintOut.Caption & ".pdf"
DoCmd.OutputTo acOutputReport, "", acFormatPDF, mypdfpath, False
DoCmd.Close acReport, "rptPrintOut"




End If




Next


End If




Next


























End Function