Help with VBA code that was working but now is not (1 Viewer)

[sammylou]

I have some code which basically opens up a query called "qry_tickback_template2" and by looping through a table called "tble_List_Tickback_Queries_Criteria_GTM" it changes the parameters each time and creates excel files based on each record criteria. The criteria for the query is held in the table above as field called "MYWHERE" which contains an sql where string and also the Excel file name is held in this table as "FileName".

Up until a week ago the code was working fine and now it has stopped and I am struggling to understand what is wrong. When I step through the code I can see that although the "qry_tickback_template2" is having its sql criteria changed, when the code gets to the dim called "RRun" its value is nothing. The query run directly brings back records so I know it is the code that has stopped working?!

PLEASE HELP I am going round in circles with this, Thanks

Code:

Function tickback_Export_GTM()
On Error Resume Next
Dim q As QueryDef, db As dao.Database, param1 As String, param2 As String, myrecordsin As dao.Recordset, strXLFile As String, xlApp As Excel.Application, xlBook As Excel.workbook, xlSheet As Excel.Worksheet
Dim t As Long, w As Long, x As Long, y As Long, z As Long, RRun As dao.Recordset, NumIterations As Integer, inti As Integer, dblPct As Double
Dim pgbar As progressbar
Set pgbar = Forms![TickBack_List].ProgressBar9.Object


NumIterations = DCount("Query_Name", "tble_List_Tickback_Queries_Criteria_GTM")


' Modify the Query.
Set db = CurrentDb()
Set q = db.QueryDefs("qry_tickback_template2")
Set myrecordsin = db.OpenRecordset("tble_List_Tickback_Queries_Criteria_GTM")

myrecordsin.MoveFirst
inti = 1

Do While Not myrecordsin.EOF


pgbar.Max = NumIterations
pgbar.Scrolling = ccScrollingSmooth
pgbar.Appearance = cc3D
pgbar.Min = 0
pgbar = 0

pgbar.Value = inti
dblPct = inti / NumIterations
Forms![TickBack_List].txtPctComplete = dblPct
Forms![TickBack_List].txtPctComplete.Requery
'Forms![TickBack_List].boxPct.Width = Forms![TickBack_List].boxWhole.Width * dblPct
'Forms![TickBack_List].txtI = inti

'**********************************************************************************************************************

param1 = Left$(myrecordsin("MyWHERE"), 255)
param2 = Mid$(myrecordsin("MyWHERE"), 256)
'param = myrecordsin("MyWHERE")



'**********************************************************************************************************************

strXLFile = myrecordsin("FileName")

Kill "c:\temp\" & strXLFile
Kill "K:\COMMON\DIS\Report Logging Database\Outputs\Tickback_Output\" & strXLFile
Set xlApp = CreateObject("Excel.Application")
xlApp.DisplayAlerts = False
xlApp.Visible = True
Set xlBook = xlApp.Workbooks.Open("c:\temp\" & strXLFile)

If Err.Number = 0 Then
Else
Set xlBook = xlApp.Workbooks.Add
End If


Set xlSheet = xlBook.Worksheets.Add
xlSheet.Name = "Tickback"

q.SQL = "SELECT qry_tickback_template.* FROM qry_tickback_template " & param1 & param2
'Q.Close

' Run the query.
DoCmd.SetWarnings False
'DoCmd.OpenQuery "qry_tickback_template2"
varretval = SysCmd(acSysCmdSetStatus, "Creating " & strXLFile)
'********************************************************************
Set RRun = db.OpenRecordset("qry_tickback_template2")

y = 1
x = 0

'x in the following line being the column of data from RRun
For x = 0 To RRun.fields.Count

xlSheet.cells(1, x + 1).Value = RRun.fields(x).Name
'xlSheet.cells(1, x).Value = RRun.fields(x).Name
'Exit For

Next x


'MAKE SURE you start at row 2 column 1
y = 2
x = 0
'INSERT DATA ON SPREADSHEET x = Column y = row
RRun.MoveFirst
Do While Not RRun.EOF

For x = 0 To RRun.fields.Count
'xlSheet.cells(Y, X - 1).Value = RRun.Fields(X).Value
xlSheet.cells(y, x + 1).Value = RRun.fields(x).Value
'Exit For
Next x

y = y + 1

RRun.MoveNext
Loop


xlSheet.Range("a1:Ab1").Font.Bold = True
xlSheet.Range("q1:w1").Font.Color = RGB(255, 0, 0)
xlSheet.Range("a1:Ab1").Rows.Interior.ColorIndex = 15
Dim highlrow As String
Dim BORDERrow As String
highlrow = "w" & CStr(y - 1)
xlSheet.Range("q2", highlrow).Rows.Interior.ColorIndex = 36
BORDERrow = "ab" & CStr(y - 1)
xlSheet.Range("A2", BORDERrow).VerticalAlignment = xlTop

xlSheet.Range("A2", BORDERrow).Borders.Color = 0
xlSheet.Range("A2", BORDERrow).Borders.LineStyle = xlContinuous
xlSheet.Range("A2", BORDERrow).Borders.Weight = xlThin


xlSheet.SaveAs "c:\temp\" & strXLFile
xlSheet.Columns.AutoFit
'Delete unwanted sheets
For x = 1 To xlBook.Worksheets.Count
If xlBook.Worksheets(x).Name Like "Sheet*" Then
xlBook.Worksheets(x).Delete
End If
Next x


xlSheet.SaveAs "c:\temp\" & strXLFile
xlBook.Close
FileCopy "c:\temp\" & strXLFile, "K:\COMMON\DIS\Report Logging Database\Outputs\Tickback_Output\" & strXLFile


myrecordsin.MoveNext
inti = inti + 1
Loop


DoCmd.SetWarnings True
db.Close
Set db = Nothing
Set xlSheet = Nothing
Set xlBook = Nothing
Set xlApp = Nothing
Call statusreset
' Release the object variable
Set RRun = Nothing
End Function

 

[sammylou]

I would really appreciate if someone can help with this

Thanks

Sam

 

[tehNellie]

If you debug.print q.sql after this line:

q.SQL = "SELECT qry_tickback_template.* FROM qry_tickback_template " & param1 & param2

What are you getting? I'm not sure exactly how those param variables are being populated, but as an SQL statement it appears to be missing the "WHERE" and the "AND/OR" syntax around those Param variables.

 

[sammylou]

The sql bit is fine, the where bit comes from a text field in the table so my q.sql is

SELECT qry_tickback_template.*
FROM qry_tickback_template
WHERE (((qry_tickback_template.SourceSystem)="Brio") AND ((qry_tickback_template.ReportFrequency)="Monthly") AND ((qry_tickback_template.[Status of Request])="completed") AND ((qry_tickback_template.Working_Day_Target) Between 6 And 10));

The problem is that when I hover over the RRun bit it says "object with or variable not set" but I am setting RRun as :

Set RRun = db.OpenRecordset(q.SQL)

It seems to be ignoring that??

 

[tehNellie]

Hadn't noticed the "On error resume next" line.

That's telling VBA to just ignore any errors and carry on which doesn't help when your code isn't working properly.

Comment that line out and step through your code one line at a time and see where your errors are. I'm not seeing anything that jumps out at me at the moment, but trying to track down errors with "resume next" set is just going to make you angry.