VB 操作写入EXCEL文件保存时的问题

hfyanzi 2006-11-28 07:23:14

各位好：
原代码如下：
Dim cn As New ADODB.Connection
Dim rs As ADODB.Recordset
Set cn = New ADODB.Connection
cn.ConnectionString = "Provider=SQLOLEDB.1;Persist Security Info=False;User ID=xx;Password=xx;Initial Catalog=dataservername;Data Source=data1"
cn.CursorLocation = adUseClient
cn.Open

Dim ExlApp As Excel.Application
Dim ExlBook As Excel.Workbook
Dim ExlSheet As Excel.Worksheet
Dim sql As String
Dim strdata As String

If Combo1.Text = "仓库编号" Then
sql = "select 列1,列2 from curr"
Else
sql = "select 列1,列2 from curr where curr.xx=1"
End If

Set rs = cn.Execute(sql)
If Not rs.EOF Then
Set ExlApp = CreateObject("Excel.Application")
ExlApp.Visible = False
Set ExlBook = ExlApp.Workbooks.Add
Set ExlSheet = ExlBook.Worksheets(1)
ExlSheet.Activate
Row = 3
With ExlSheet
strdata = Year(Now) & "-" & Right("00" & Month(Now), 2) & "-" & Right("00" & Day(Now), 2) & "-" & Right("00" & Hour(Now), 2) & "-" & Right("00" & Minute(Now), 2) & "-" & Right("00" & Second(Now), 2)
.Cells(1, 1) = "库存管理系统——分库库存"
.Cells(2, 1) = "数据导出日期：" & strdata
.Cells(3, 1) = "厂商货号"
.Cells(3, 2) = "数量"

.Cells.Font.Size = 9

Do While Not rs.EOF
Row = Row + 1
.Cells(Row, 1) = rs(0)
.Cells(Row, 2) = rs(1)
rs.MoveNext
Loop
.Range(.Cells(2, 1), .Cells(Row, 2)).Borders.LineStyle = xlContinuous
End With
CommonDialog1.Filter = "EXCEL文件(*.xls)|*.xls|"
CommonDialog1.DialogTitle = "保存文件"
CommonDialog1.ShowSave
If Len(CommonDialog1.FileName) = 0 Then Exit Sub
strExcelfile = CommonDialog1.FileName
ExlBook.Close
Set ExlSheet = Nothing
Set ExlBook = Nothing
ExlApp.Quit
Set ExlApp = Nothing
MsgBox "生成完毕，文件名：" & strExcelfile, vbOKOnly, "信息提示"
Else
MsgBox "没有符合条件的返还记录。", vbOKOnly, strmsg
End If

cn.Close
Set cn = Nothing

当我要导出数据到EXCEL的时候，调出存储对话框，如果保存的文件已存在，这个时候会软件会询问：当前位置发现已经存在名为“xxxx.xls”的文件。您希望将该文件替换掉吗？如果选是，软件不会出错，但如果选择否或者取消时就会出现以下错误：运行时错误'1004' 方法'~'作用于对象'~'失败。

请各位指教如何更改程序不让它出现这个错误。先谢了！

...全文