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

[axiao5137]

我通过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秒。所以想请问各位有没有好办法解决这个问题。谢谢！！

[yoki]

你可以在添加前清除掉旧的记录呀

[liaorui]

添加之前把数据清空..

[SoHo_Andy]

这样试试
在添加数据之前清除所有单元格数据

xlApp.Sheets("Sheet1").Select
xlApp.Cells.Select
xlApp.Selection.ClearContents

[axiao5137]

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

[maskzha]

如果你的表样是不规则或动态创建的话最好是在程序里面创建表头和画网格线。

最好是全部由程序控制。

[SoHo_Andy]

自动增加列数没试过,不过你可以把范围定得大点
数据量小没影响,大了还是可以添加

试试

[axiao5137]

我没办法预测它的数据量到底有多大的，可以通过程序动态给它加吗？？如果可以，请问如何做？？不好意思，刚接触这方面的东西，笨！谢谢了！！

[SoHo_Andy]

如果你是把记录集导出到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

[axiao5137]

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

[yoki]

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

[axiao5137]

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

[axiao5137]

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

[dream901]

gz

[ghscsdn]

我是新手，有点拙见
你可以不覆盖你的模板，把他存到别的位置呀
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 String

Set oBook = oExcel.Workbooks.Open(App.Path & "\Report\Template\" & ReportName & ".XLS")
Set oSheet = oBook.Sheets(1)

FillData ReportID, oSheet, RowsCnt, RepDate

NewXLS = App.Path & "\Report\" & ReportName & RepDate & ".XLS"
On Error Resume Next
If oTools.File(NewXLS) Then Kill NewXLS
oBook.Saved = True
oBook.SaveAs NewXLS

oExcel.Visible = True

Set oSheet = Nothing
Set oBook = Nothing
Set oExcel = Nothing
End Sub

[axiao5137]

没人帮忙吗？？

[dream901]

gz

[dream901]

gz