Question

最近，我们公司雇用了一个新的合作社，并负责运行一份报告。该报告查询数据库并返回结果集，然后从该处开始创建电子表格。根据选择的天数，会生成不同数量的报告，但我不认为这与问题有关。基本上它运行报告并循环通过结果集，但在某些时候继续循环直到它停止的两个65536。例如，如果结果集包含74个记录，那么前74行将正常显示（格式化为黄色），而之后的所有内容也将被格式化为黄色，尽管它应该保持不变。我继承这个代码，因为我是一个新的合作社。显然，这只发生在“警卫变更”发生时（新合作社必须运行报告）。“

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`

另外我应该注意到，这一切都发生在一个访问数据库中，该数据库的表由SQL链接。查询的运行速度非常慢，我认为这是对视图的使用，但这既不是在这里也不是在那里。您必须知道的是，由于必须等待记录集返回，因此尝试调试会花费大量时间。我的猜测是它没有检查结果集是否正确为空。有没有办法我可以查看是否有一个值是rs.Fields（0）并且可能是基于它？这是ID列，应始终有值。我想知道为什么rs.EOF没有抓住这个。

Answer 1

65536是重要的，因为它比可以存储在16位无符号整数中的最大值多1个。所以有些东西在某处溢出。

这不是VBA整数，因为它们已签名，但我仍然会用CInt()替换CLng()并确保i之类的计数器变量声明为

您是否在禁用错误处理的情况下运行它以查看是否出现任何错误？

对于调试，您可以交换到ADO，运行一次并将结果保存到磁盘（RS.Save），然后将RS.Open该文件保存到后续运行中。

Answer 2

一些观察结果，其中没有一个是你问题的答案，但可能会指出你正确的方向：

更改空记录集的测试/何时停止循环。

替换此代码：

  If Not rs.EOF Then
     rs.MoveFirst
     Do While Not rs.EOF And Not rs.BOF 
       [...]
       rs.MoveNext

......用这个：

  If rs.RecordCount<> 0
     rs.MoveFirst
     Do While Not rs.EOF
       [...]
       rs.MoveNext

更改第二个记录集的使用方式。

不要为每一行打开一次，针对该行进行过滤，但是打开它未经过滤并按先前过滤的值排序并使用FindFirst进行导航：

  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)

...或者使第二个记录集过时。

更好，但是，看起来这里有一个值匹配，因为rs2永远不会导航超过第一个匹配，所以为什么不看看你是否可以改变保存的QueryDef“DailySummaryMain”来加入dbo_StatusType，这样值就是在单一记录集中？那么你根本就不需要rs2。

通过序数来引用字段通常是不明智的。

通过在SELECT语句末尾以外的任何地方向源SELECT语句添加新字段来完全管理例程太简单了。因此，将序数更改为实际字段名称，以便rs（0）变为rs（“NameOfFirstField”）。

使用SELECT CASE而不是链接If / Then / ElseIf / Else。

更改此代码：

  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

......对此：

  Select Case rs.Fields(2)
    Case 1
      row = row1
    Case 2
      row = row2
    Case 3
      row = row3
    Case 4
      row = row4
  End Select

或者，因为除了一个案例之外的所有案例都可以从值构建，请执行以下操作：

  If rs.Fields(2) = 4 Then
     row = row4
  Else
     row = Eval("row" & rs.Fields(2))
  End If

上下文并不完全清楚（row和rowN项的含义不清楚 - 它们是变量是某种对象吗？），所以也许最后一个不起作用（Eval（）并不总是如此工作似乎应该），所以我可能会选择SELECT CASE。

Excel可能需要.Value但Access不需要。

改变这个：

  xlapp.Range("A" & i).Value = rs.Fields(0).Value