yoki(小马哥)、SoHo_Andy(冰)或其他高手请帮忙：数据库记录导出到Excel模板后，再次导出不能覆盖原纪录的问题。

我通过VB将SQL Server 2000的某张表的记录导出到一个已经建好的Excel 2000模板里去，第一次导出正常；但再一次导出的时候结果不是我希望的，我希望第二次导出的数据恢会覆盖原来的，而不是在前面再添加一次。我用的添加数据的方法如下：
Set xlQuery = xlSheet.QueryTables.Add(Rs_Data, xlSheet.Cells(11, 2))；此外，我发现如果是循环取数据添加的话就不会有不能覆盖的现象，方法如下：
ReDim rsTable(lngRowCount, lngColCount)
For i = 1 To lngRowCount
    For j = 0 To lngColCount - 1
        rsTable(i, j + 1) = RS.Fields(j)
        '添加查询语句，导入EXCEL数据
        xlSheet.Cells(i + 10, j + 2) = rsTable(i, j + 1)
    Next
    RS.MoveNext
Next但是第二种方法时间明显增长，700条记录用一只需要2秒钟，用二则要37秒。所以想请问各位有没有好办法解决这个问题。谢谢！！

解决方案 »

  1.   

    试试：
    Set xlQuery = xlSheet.QueryTables.Add(Rs_Data, xlSheet.Cells(11, 2))；
    xlQuery.RefreshStyle = xlInsertDeleteCells
      

  2.   

    我试过了，用这种方法不行xlQuery.RefreshStyle = xlInsertDeleteCells；
    请问，“添加前清除掉旧的记录”，指的是用VBA的方法将旧记录清除掉吗？如何做呢？
      

  3.   

    这样试试
    在添加数据之前清除所有单元格数据    xlApp.Sheets("Sheet1").Select
        xlApp.Cells.Select
        xlApp.Selection.ClearContents
      

  4.   

    SoHo_Andy(冰)，
    用了你的方法，它就会把模板了所有数据都清除掉了，包括我想清除的和不想清除的，然后参考了你的方法，用了下面的语句：xlSheet.Range("B11:L16").ClearContents，这样的话就定死了只删某一区域的内容了。
    此外，有什么办法可以让我定好的模板可以根据数据量的多少在那个范围内自动增加列数啊。
    就是，我的模板定好了Range("B11:L16")范围内是添加数据的，但数据量若超过了这一范围，它就不会往这范围里面加了。
    需要看看我的程序和Excel模板吗？？
      

  5.   

    如果你是把记录集导出到Excel表的
    在导出之前可以知道记录集的列数和行数的,按照得到的函数和列数
    可以控制导出的范围
    行数 nRow=rs.recordcount
    列数 nCol=rs.fields.count利用行数和列数控制Range的范围试试
    Private Sub Command1_Click()
        Dim xlApp As New Excel.Application
        Dim xlBook  As Excel.Workbook
        Dim xlSheet As Excel.Worksheet
        
        xlApp.Caption = "test"
        Set xlBook = xlApp.Workbooks.Add
        Set xlSheet = xlBook.Worksheets(1)'定义并得到行列    
        Dim nRow As Integer
        Dim nCol As Integer
        
        nRow = 20
        nCol = 15'构造范围字符串
        Dim str1 As String
        str1 = "B11:" & Chr(Asc("B") + nCol) & (11 + nRow)'选中这个区域
        xlApp.Range(str1).Select'清除并导入数据    
        
        xlApp.Visible = True
    End Sub
      

  6.   

    不好意思，刚才表达不清晰，我的意思是：我定义了模板中添加数据的区域大小，譬如Range("B11:L16")；但是要取的数据条数可能超过这个范围，可能在这个范围内；
    那么我希望可以根据数据条数通过程序动态的调整区域的范围，譬如我知道了数据有10条，而模板定的区域不够（Range("B11:L16")），就通过程序动态的加长区域的范围，可以实现吗？？如果可以，请问如何做？
    因为，假如数据量很大：1000条，那我定的模板就好痛苦了
      

  7.   

    我是新手，有点拙见
    你可以不覆盖你的模板，把他存到别的位置呀
    Public Sub PrintReport(ReportName As String, ReportID As Integer, RowsCnt As Integer, RepDate As String)
    Dim oExcel As New excel.Application
    Dim oBook As excel.Workbook
    Dim oSheet As excel.Worksheet
    Dim NewXLS As StringSet oBook = oExcel.Workbooks.Open(App.Path & "\Report\Template\" & ReportName & ".XLS")
    Set oSheet = oBook.Sheets(1)FillData ReportID, oSheet, RowsCnt, RepDateNewXLS = App.Path & "\Report\" & ReportName & RepDate & ".XLS"
    On Error Resume Next
    If oTools.File(NewXLS) Then Kill NewXLS
    oBook.Saved = True
    oBook.SaveAs NewXLSoExcel.Visible = TrueSet oSheet = Nothing
    Set oBook = Nothing
    Set oExcel = Nothing
    End Sub
      

  8.   

    SoHo_Andy(冰)
    我参照你上面的给定区域范围的那种做法作了，这样的话如果记录条数不超过模板定义的区域范围就可以覆盖，超过的话它就不往模板里加了。不知道是不是某些属性没有设置。
    ghscsdn(宏) 
    现在是发觉记录条数超过模板定义的区域范围它就不往模板里加了。
    非常痛苦啊，请大家帮忙解决呀！！！模板中添加数据的范围是Range(B11:L16)(我以为它会自动增长的)
    我的部分程序：    Cn = "DRIVER={SQL Server};SERVER=192.168.200.25;DATABASE=pubs;UID=cx;PWD=cx;OPTION=3"
        With Rs_Data
            If .State = adStateOpen Then
                .Close
            End If
            .ActiveConnection = Cn
            .CursorLocation = adUseClient
            .CursorType = adOpenStatic
            .LockType = adLockReadOnly
            .Source = strOpen
            .Open
        End With
        With Rs_Data
            If .RecordCount < 1 Then
                MsgBox ("没有记录!")
                Exit Function
            End If
            '记录总数
            lngRowcount = .RecordCount
            '字段总数
            lngColcount = .Fields.Count
        End With    
        Set xlApp = CreateObject("Excel.Application")
        Set xlBook = Nothing
        Set xlSheet = Nothing
        Set xlBook = xlApp.Workbooks.Open("F:\Project_DOC\B-S\Example\一次加进模板\劳保办结算统计表.xls")
        Set xlSheet = xlBook.Worksheets("sheet1")
        xlApp.Visible = True
        
        lngTemp = 11 + lngRowcount
        strTemp = "B11:L" & CStr(lngTemp)
        xlSheet.Range(strTemp).ClearContents
        xlApp.Range(strTemp).Select
        xlApp.Range(strTemp).Activate
        
        '添加查询语句，导入EXCEL数据
        Set xlQuery = xlSheet.QueryTables.Add(Rs_Data, xlSheet.Cells(11, 2))
        
        With xlQuery
            '.FieldNames = True
            .RowNumbers = False
            .FillAdjacentFormulas = False
            .PreserveFormatting = True
            .RefreshOnFileOpen = False
            .BackgroundQuery = True
            .RefreshStyle = xlInsertDeleteCells
            .SavePassword = True
            .SaveData = True
            .AdjustColumnWidth = True
            .PreserveColumnInfo = True
        End With
        
        xlQuery.FieldNames = False '显示字段名
        xlQuery.Refresh    ExclFileName = strAppPath & sFileName & ".xls"    xlApp.Application.Visible = True      '"交还控制给Excel
        xlApp.WindowState = xlMaximized
       
        xlBook.Save
        xlApp.Quit
        Set xlApp = Nothing
        Set xlBook = Nothing
        Set xlSheet = Nothing