vb 连续导出EXCEL表问题 第一次可以保存，第二次在保存语句报“远程服务器不存在或不能使用”错误。求高手指教～～～，代码如下

Question

On Error GoTo finishDim xlApp As New Excel.Application '定义EXCEL类
Dim xlBook As New Excel.Workbook  '定义工件簿类
Dim xlsheet As New Excel.Worksheet '定义工作表类If Right(App.Path, 1) = "\" Then ' 若 App.Path 为根目录
  fullpath = App.Path + "a.xls"
Else
  fullpath = App.Path + "\" + "a.xls"
End If'打开EXCEL
Set xlApp = CreateObject("Excel.Application", "") '创建EXCEL应用类
xlApp.Visible = False '设置EXCEL可见
Set xlBook = xlApp.Workbooks.Open(fullpath)   '打开EXCEL工作簿
Set xlsheet1 = xlBook.Worksheets(1)  '打开EXCEL工作表1
xlsheet1.Activate '激活工作表(For i = 1 To Grid1.Rows - 1  xlsheet1.Cells(i + 4, 17) = Grid1.Cell(i, 6).Text '
  ssql = "select * from a"
  Set fj1 = cnn.Execute(ssql)
  If Not fj1.EOF Then
    xlsheet1.Cells(i + 4, 1) = fj1.Fields("f1") 
  End If
  
Next i    xlsheet1.Range("A" & i + 4 & ":X" & i + 4).Select     With xlApp.Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
        .RowHeight = 30
    End With
'***************
    Selection.Merge
'运行第二遍时停在这个地方
'报错信息为“实时错误462：远程服务器不存在或不能使用”
'********************
    xlsheet1.Cells(i + 4, 1) = " 合并表格 "
With CommonDialog1
.DialogTitle = "生成Excel"
.FileName = "*.xls"
.Filter = "(Excel)*.xls|*.xls"
.CancelError = True
.ShowSave
End WithxlBook.SaveAs (CommonDialog1.FileName)
SaveChanges = TruexlBook.Close
Set xlsheet = Nothing
Set xlBook = Nothing
xlApp.Quit
Set xlApp = Nothing
Application.QuitShell "taskkill /im EXCEL.exe /f", vbHide '强行杀死EXCEL.EXE进程
 
MsgBox "数据导Excel完成！", 48, "信息"Exit Sub
finish:
    If Err.Number = 429 Then
        MsgBox "请先安装EXCEL!", , "导出错误"
        Exit Sub
    End If
    
    xlApp.DisplayAlerts = False '关闭时不提示保存
    xlApp.Quit '关闭EXCEL
    xlApp.DisplayAlerts = True  '关闭时提示保存
    Set xlApp = Nothing
    MsgBox " 导出数据到 Excel 时出错! ", , "导出错误"

Answer 1

Shell "taskkill /im EXCEL.exe /f", vbHide '强行杀死EXCEL.EXE进程
和
On Error GoTo finish 都不是什么好玩意儿

Answer 2

getemail肯定没有看过code complete

Answer 3

xlsheet1.Activate '激活工作表( 
Application.Quit 
都是多余

Answer 4

估计是：
xlApp.Quit 
Set xlApp = Nothing 
还没完成的时候Shell "taskkill /im EXCEL.exe /f", vbHide '强行杀死EXCEL.EXE进程开始工作了别的暂时没找出来

Answer 5

http://download.csdn.net/source/1627060

Answer 6

Private Sub Command1_Click()
On Error GoTo finishDim xlApp As New Excel.Application '定义EXCEL类
Dim xlBook As New Excel.Workbook  '定义工件簿类
Dim xlsheet As New Excel.Worksheet '定义工作表类If Right(App.Path, 1) = "\" Then ' 若 App.Path 为根目录
  fullpath = App.Path + "a.xls"
Else
  fullpath = App.Path + "\" + "a.xls"
End If'打开EXCEL
Set xlApp = CreateObject("Excel.Application", "") '创建EXCEL应用类
xlApp.Visible = False '设置EXCEL可见
Set xlBook = xlApp.Workbooks.Open(fullpath)  '打开EXCEL工作簿
Set xlsheet1 = xlBook.Worksheets(1)  '打开EXCEL工作表1
xlsheet1.Activate '激活工作表(For i = 1 To Grid1.Rows - 1  xlsheet1.Cells(i + 4, 17) = Grid1.Cell(i, 6).Text '
  ssql = "select * from a"
  Set fj1 = cnn.Execute(ssql)
  If Not fj1.EOF Then
    xlsheet1.Cells(i + 4, 1) = fj1.Fields("f1")
  End If
  
Next i    xlsheet1.Range("A" & i + 4 & ":X" & i + 4).Select    
         xlApp.Selection.HorizontalAlignment = xlLeft
         xlApp.Selection.VerticalAlignment = xlCenter
         xlApp.Selection.WrapText = True
         xlApp.Selection.Orientation = 0
         xlApp.Selection.AddIndent = False
         xlApp.Selection.IndentLevel = 0
         xlApp.Selection.ShrinkToFit = False
         xlApp.Selection.ReadingOrder = xlContext
         xlApp.Selection.MergeCells = False
         xlApp.Selection.RowHeight = 30
  
'***************  xlApp.Selection.Merge
    
'运行第二遍时停在这个地方
'报错信息为“实时错误462：远程服务器不存在或不能使用”
'********************
    xlsheet1.Cells(i + 4, 1) = " 合并表格 "
With CommonDialog1
.DialogTitle = "生成Excel"
.FileName = "*.xls"
.Filter = "(Excel)*.xls|*.xls"
.CancelError = True
.ShowSave
End WithxlBook.SaveAs (CommonDialog1.FileName)
SaveChanges = TruexlBook.Close
Set xlsheet = Nothing
Set xlBook = Nothing
xlApp.Quit
Set xlApp = Nothing
Application.QuitShell "taskkill /im EXCEL.exe /f", vbHide '强行杀死EXCEL.EXE进程MsgBox "数据导Excel完成！", 48, "信息"Exit Sub
finish:
    If Err.Number = 429 Then
        MsgBox "请先安装EXCEL!", , "导出错误"
        Exit Sub
    End If
    
    xlApp.DisplayAlerts = False '关闭时不提示保存
    xlApp.Quit '关闭EXCEL
    xlApp.DisplayAlerts = True  '关闭时提示保存
    Set xlApp = Nothing
    MsgBox " 导出数据到 Excel 时出错! ", , "导出错误"End Sub

Answer 7

回答过 N 遍了
a)不能用 As New 
b)要按照从小到达的次序（xlSheet、xlBook、xlApp）释放对象

Answer 8

xlsheet1.Cells(i + 4, 1) = " 合并表格 " 
后面那些都可以删除

Answer 9

goosen，按照你的方法Selection前面加上xlApp，问题解决了，谢谢啊！