代码之家 › 专栏 › 技术社区 › Gage

怪异的Excel格式

resultset vb6 ms-access excel

Gage · 技术社区 · 16 年前

最近我们公司雇用了一家新的合作公司,并被派去做一份报告。报表查询数据库并返回结果集,然后从中继续创建电子表格。根据所选的天数,会生成不同数量的报告,但我不认为这与问题有关。基本上,它运行报告并循环通过结果集,但在某个点继续循环直到tow 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`

另外,我还应该注意,这一切都发生在一个Access数据库中,该数据库的表与SQL链接。查询运行非常缓慢,我认为从中可以使用视图,但这既不是这里也不是那里。您只需知道,由于必须等待记录集返回,因此尝试调试需要花费大量时间。我的猜测是,它不会检查结果集是否正确为空。有没有一种方法可以检查是否有一个值是rs.fields(0),并以此为基础?这是ID列,应该始终有一个值。我想知道为什么Rs.eof没有抓住这个。

2 回复 | 直到 16 年前

David-W-Fenton 16 年前

一些观察结果,其中任何一个都不构成对您问题的回答,但可能会为您指明正确的方向:

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

替换此代码:

  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而不是chained if/then/else if/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

上下文并不完全清楚(行和行项目的含义不清楚——它们的变量是某种类型的对象吗?),所以最后一个可能不起作用(eval()在它看起来应该起作用的情况下并不总是起作用),所以我可能会选择这个案例。

Excel可能需要.value,但Access不需要。

改变这一点:

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

……

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

您可能也不需要它作为公式的excel部分。

Alex K. 16 年前

65536是有效的,因为它的1大于可以存储在16位无符号整数中的最大值。所以有些东西溢出了。

这不会是一个有符号的VBA整数,但我仍然会替换 CInt() 带着 CLng() 确保计数器变量 i 声明为长

是否在禁用错误处理的情况下运行它以查看是否引发了任何错误?

至于调试,您可以切换到ADO,运行一次并将结果保存到磁盘( RS.Save ) RS.Open 用于后续运行的文件。