Weird Excel Formatting
Recently a new co-op was hired at our company and has been tasked to run a report. The report queries the database and returns a resultset and from there procedes to create the spreadsheets. Depending on the number of days selected a different number of reports are generated but I do not believe that is relavent to the question. Basically it runs the reports and loops through the resultset but at some point continues to loop through until tow 65536 at which it stops. For Example if the resultset contained 74 records then the first 74 rows would appear normally (formatted yellow) while everything after that would also be formatted yellow although it should be left alone. I am inheriting this code as I to am a new co-op. Apparently this only happens when a "change of guards" happens (New co-op has to run the report).`
DoCmd.SetWarnings False
DoCmd.OpenQuery ("DailySummaryQueryMain")
strSQL = "SELECT * FROM DailySummaryMain"
Set rs = CurrentDb.OpenRecordset(strSQL)
DoCmd.Echo True, "Running first Report"
If Not rs.EOF Then
rs.MoveFirst
Do While Not rs.EOF And Not rs.BOF
xlapp.Range("A" & i).Value = rs.Fields(0).Value
xlapp.Range("B" & i).Value = rs.Fields(1).Value
xlapp.Range("C" & i).Value = rs.Fields(2).Value
Set rs2 = CurrentDb.OpenRecordset("SELECT dbo_StatusType.StatusTypeID, dbo_StatusType.Name FROM dbo_StatusType WHERE (((dbo_StatusType.StatusTypeID)=" & rs.Fields(3) & "))")
rs2.MoveFirst
xlapp.Range("D" & i).Value = rs2.Fields(1).Value
xlapp.Range("E" & i).Value = rs.Fields(4).Value
xlapp.Range("F" & i).Value = rs.Fields(5).Value
xlapp.Range("G" & i).Value = rs.Fields(6).Value
'count number of outages that start and end on same day
If Format(xlapp.Range("F" & i).Value, "mm/dd/yyyy") = Format(xlapp.Range("G" & i).Value, "mm/dd/yyyy") Then
dayCount = dayCount + 1
End If
xlapp.Range("H" & i).Value = rs.Fields(7).Value
xlapp.Range("I" & i).Value = rs.Fields(8).Value
xlapp.Range("J" & i).Value = rs.Fields(9).Value
xlapp.Range("K" & i).Value = rs.Fields(10).Value
xlapp.Range("L" & i).Value = rs.Fields(11).Value
xlapp.Range("M" & i).Value = rs.Fields(12).Value
xlapp.Range("N" & i).Value = rs.Fields(13).Value
'highlite recently modified rows
If rs.Fields(14).Value = "Yes" Then
xlapp.Range("A" & i & ":N" & i).Select
With xlapp.Selection.Interior
.ColorIndex = 36
.Pattern = xlSolid
End With
End If
'break apart by sector
If CInt(rs.Fields(2).Value) = 1 Then
row = row1
ElseIf CInt(rs.Fields(2).Value) = 2 Then
row = row2
ElseIf CInt(rs.Fields(2).Value) = 3 Then
row = row3
Else
row = row4
End If
xlapp.Worksheets(CInt(rs.Fields(2).Value) + 1).Activate
xlapp.Range("A" & row).Value = rs.Fields(0).Value
xlapp.Range("B" & row).Value = rs.Fields(1).Value
xlapp.Range("C" & row).Value = rs.Fields(13).Value
xlapp.Range("D" & row).Value = rs.Fields(4).Value
xlapp.Range("E" & row).Value = rs.Fields(5).Value
xlapp.Range("F" & row).Value = rs.Fields(6).Value
xlapp.Range("G" & row).Value = rs.Fields(7).Value
xlapp.Range("H" & row).Value = rs.Fields(8).Value
xlapp.Range("I" & row).Value = rs.Fields(9).Value
xlapp.Range("J" & row).Value = rs.Fields(10).Value
xlapp.Range("K" & row).Value = ""
xlapp.Range("L" & row).Value = rs.Fields(11).Value
xlapp.Range("M" & row).Value = rs.Fields(13).Value
If CInt(rs.Fields(2).Value) = 1 Then
row1 = row1 + 1
ElseIf CInt(rs.Fields(2).Value) = 2 Then
row2 = row2 + 1
ElseIf CInt(rs.Fields(2).Value) = 3 Then
row3 = row3 + 1
Else
row4 = row4 + 1
End If
'activate main summary sheet for next outage
xlapp.Worksheets(1).Activate
i = i + 1
rs.MoveNext
Loop`
Also I should note that this is all happening within an access database which has its tables linked from SQL. The query is extremely slow to run from which I believe is the use of views but thats neither here nor there. All you have to know is attempting to debug takes an enormous amount of time due to having to wait for the recordset to return. My guess is that its not checking to see if the resultset is empty correctly. Is there a way I could che开发者_运维问答ck to see if theres a value is rs.Fields(0) and base it off that maybe? That is the ID column and there should always be a value. I am wondering why rs.EOF isn't catching this though.
A few observations, none of which constitutes an answer to your question, but might point you in the right direction:
Change your tests for empty recordset/when to stop looping.
Replace this code:
If Not rs.EOF Then
rs.MoveFirst
Do While Not rs.EOF And Not rs.BOF
[...]
rs.MoveNext
...with this:
If rs.RecordCount<> 0
rs.MoveFirst
Do While Not rs.EOF
[...]
rs.MoveNext
Change the way the second recordset is used.
Don't open it once for every row, filtered for that row, but open it unfiltered and sorted by the value you were previously filtering on and use FindFirst to navigate it:
Set rs = CurrentDb.OpenRecordset("SELECT * FROM DailySummaryMain")
Set rs2 = CurrentDb.OpenRecordset("SELECT dbo_StatusType.StatusTypeID, dbo_StatusType.Name FROM dbo_StatusType ORDER BY dbo_StatusType.StatusTypeID")
[...]
rs2.FindFirst "[StatusTypeID]=" & rs.Fields(3)
...Or make the second recordset obsolete.
Better, yet, it looks like there's a single value matching here, since rs2 is never navigated past the first match, so why not see if you can alter the saved QueryDef "DailySummaryMain" to join to dbo_StatusType so that the value is right there in the single recordset? Then you wouldn't need rs2 at all.
It's usually pretty unwise to refer to fields by ordinal number.
It's way too easy to completely hose your routine by adding a new field to the source SELECT statement anywhere other than the end of the SELECT statement. So, change the ordinal numbers to actual field names, so that rs(0) becomes rs("NameOfFirstField").
Use SELECT CASE instead of chained If/Then/ElseIf/Else.
Change this code:
If CInt(rs.Fields(2).Value) = 1 Then
row = row1
ElseIf CInt(rs.Fields(2).Value) = 2 Then
row = row2
ElseIf CInt(rs.Fields(2).Value) = 3 Then
row = row3
Else
row = row4
End If
...to this:
Select Case rs.Fields(2)
Case 1
row = row1
Case 2
row = row2
Case 3
row = row3
Case 4
row = row4
End Select
Or, because all but one case can be constructed from the value, do this:
If rs.Fields(2) = 4 Then
row = row4
Else
row = Eval("row" & rs.Fields(2))
End If
The context is not entirely clear (the meaning of the row and rowN items is not clear -- are they variables are objects of some kind?), so maybe that last won't work (Eval() doesn't always work in case where it seems it should), so I'd probably go with the SELECT CASE.
Excel may need .Value but Access doesn't.
Change this:
xlapp.Range("A" & i).Value = rs.Fields(0).Value
...to this:
xlapp.Range("A" & i).Value = rs.Fields(0)
You may not need it for the Excel side of the equation, either.
65536 is significant as its 1 more than the maximum value that can be stored in a 16bit unsigned integer .. so something is overflowing somewhere.
This won't be a VBA integer as they are signed, but I still would replace the CInt()
s with CLng()
and ensure counter variables like i
are declared as long
Have you run it with error handling disabled to see if any errors are raised?
As for debugging, you can swap to ADO, run it once and save the results to disk (RS.Save
) then RS.Open
that file for subsequent runs.
精彩评论