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

Question

我用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

Answer 1

'請你自己加個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

Answer 2

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

Answer 3

'一个例子：
'工程->引用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