请教导出Excel问题，请赐教，在线等

[ajianchen2002]

我用VB把记录导出到EXCEL文件时，如果出现同名的文件，为什么覆盖之前不能将已有的数据清空？
并且覆盖时并不是所有的记录都追加到已有的文件，而是每执行一次，会多出一条记录？
请叫高手这个问题怎么解决？
非常感谢
问题解决立即结贴
附代码如下：
If MsgBox("文件已经存在，你要替换吗？", vbQuestion + vbYesNo, "提示信息") = vbNo Then
Call cmdDataGridToExcel_Click
End If
Set BookExcel = AppExcel.Workbooks.Open(ExcelFileName)
' AppExcel.Worksheets.
AppExcel.Worksheets(1).Name = ExcelFileName
AppExcel.Worksheets(1).Range("A1").CopyFromRecordset rsWorking
'设置列宽
AppExcel.Worksheets(1).Columns(9).ColumnWidth = 12
'添加EXCEL的表头
AppExcel.Worksheets(1).Rows(1).Insert (1)
For i = 1 To rsWorking.Fields.count
AppExcel.Worksheets(1).Cells(1, i) = rsWorking.Fields.Item(i - 1).Name
Next i
BookExcel.Save

[Andy__Huang]

'請你自己加個CommonDialog控件
Private Sub Command3_Click()
Dim objFileSystem As Object
Dim objExcelText As Object
Dim strTableString As String, i As Integer, strFileName As String
Dim pubConn As New ADODB.Connection
Dim rsTable As New ADODB.Recordset
Dim strConn As String
Dim strSQL As String

strConn = "Provider=SQLOLEDB.1;Persist Security Info=False;User ID=develop; password=12345;Data Source=ServerNmae"
pubConn.Open strConn
rsTable.CursorLocation = adUseClient
strSQL = "select top 10 * from gate_register"
rsTable.Open strSQL, pubConn, adOpenDynamic, adLockOptimistic

For i = 0 To rsTable.Fields.Count - 1
strTableString = strTableString & rsTable.Fields(i).Name & Chr(9) '獲取字段名
Next
strTableString = strTableString & rsTable.GetString '字段名+數據庫的記錄

cmDialog.CancelError = False
cmDialog.FileName = "FileName" '默認生成的文件名
cmDialog.DialogTitle = "Save Export File"
cmDialog.Filter = "Excel (*.xls)|*.xls|文本文件(*.DBF)|*.DBF|檔案文件(*.doc)|*.doc|所有文件(*.*)|*.*"
cmDialog.DefaultExt = "*.xls"
cmDialog.ShowSave
strFileName = cmDialog.FileName

Set objFileSystem = CreateObject("Scripting.FileSystemObject")
Set objExcelText = objFileSystem.createtextfile(strFileName, True)
objExcelText.writeline (strTableString)

objExcelText.Close
Set objFileSystem = Nothing
End Sub

[leolan]

先刪除它不就得了?

[RUKYO]

AppExcel.Worksheets(1).Range("A1").CopyFromRecordset rsWorking
中“A1”是设定由哪一行插入的参数，假如你语句为：
AppExcel.Worksheets(1).Range("A5").CopyFromRecordset rsWorking
那么就会从A5格所在行开始插入了，并且覆盖由A5格所在行的数据。

[RUKYO]

'一个例子：
'工程->引用Microsoft ActiveX Data Objects 2.x Library
'工程->引用Microsoft Excel x.0 Object Library
'窗体上放一个CommonDialog、CommandButton
Private Sub Command3_Click()
Dim pubConn As New ADODB.Connection
Dim rsTable As New ADODB.Recordset
Dim strConn As String
Dim strSQL As String
Dim AppExcel As Excel.Application
Dim BookExcel As Excel.Workbook
Dim ExcelFileName As String

On Error GoTo mErr
'On Error Resume Next

With cmDialog
cmDialog.CancelError = True
.Filter = "Excel|*.xls"
.DialogTitle = "建立输出文件"
.ShowSave
If Err = cdlCancel Then Exit Sub
ExcelFileName = .FileName
End With

strConn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\db1.mdb" & ";Persist Security Info=False"
pubConn.Open strConn
rsTable.CursorLocation = adUseClient
strSQL = "select * from Table1"
rsTable.Open strSQL, pubConn, adOpenStatic, adLockOptimistic

Set AppExcel = CreateObject("Excel.Application")
If Dir$(ExcelFileName) = "" Then
Set AppExcel = New Excel.Application
AppExcel.Visible = False
Set BookExcel = AppExcel.Workbooks.Add
AppExcel.Worksheets(1).Name = Text1.Text '在Text1中输入表名
AppExcel.Worksheets(1).Range("A1").CopyFromRecordset rsTable
BookExcel.SaveAs (ExcelFileName)
Else
Set BookExcel = AppExcel.Workbooks.Open(ExcelFileName)
AppExcel.Worksheets(1).Name = Text1.Text '在Text1中输入表名
AppExcel.Worksheets(1).Range("A1").CopyFromRecordset rsTable
BookExcel.Save
End If

AppExcel.Quit
Set BookExcel = Nothing
Set AppExcel = Nothing
rsTable.Close
Set rsTable = Nothing
pubConn.Close
Set pubConn = Nothing

MsgBox "保存完成"

Exit Sub
mErr:
MsgBox Err.Number & "," & Err.Description, vbCritical + vbOKOnly, mTitle
End
End Sub