开发者

Weird Excel Formatting

开发者 https://www.devze.com 2022-12-30 11:51 出处:网络
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

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.

0

精彩评论

暂无评论...
验证码 换一张
取 消

关注公众号