下面的代码在我第一次运行时工作正常，但是当我需要第二次运行时，它会给我这个错误：
运行时错误'462'：远程服务器计算机不存在或不可用
它确实一直在发生，我和背景excel实例作斗争，所以也许就是这样......？我在这里缺少什么？
Option Compare Database
Option Explicit
Private Sub Commande2_Click()
On Error GoTo err_Handler
MsgBox ExportRequest, vbInformation, "Terminé"
Application.FollowHyperlink CurrentProject.Path & "\Stage1.xlsm"
exit_Here:
Exit Sub
err_Handler:
MsgBox Err.Description, vbCritical, "Erreur"
Resume exit_Here
End Sub
Public Function ExportRequest() As String
On Error GoTo err_Handler
' Excel object variables
Dim appExcel As Excel.Application
Dim wbk As Excel.Workbook
Dim wks As Excel.Worksheet
Dim sTemplate As String
Dim sTempFile As String
Dim sOutput As String
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Dim sSQL As String
Dim Periode_var As String
Dim lRecords As Long
Dim iRow As Integer
Dim iCol As Integer
Dim derl As Integer
Dim iFld As Integer
Dim R As Long
Const cTabTwo As Byte = 2
Const cStartRow As Byte = 6
Const cStartColumn As Byte = 2
DoCmd.Hourglass True 'icone tablier a true
' set to break on all errors
Application.SetOption "Error Trapping", 0
' start with a clean file built from the template file
sTemplate = CurrentProject.Path & "\Output_Template.xlsm"
sOutput = CurrentProject.Path & "\Stage1.xlsm"
If Dir(sOutput) <> "" Then Kill sOutput
FileCopy sTemplate, sOutput
' Create the Excel Applicaiton, Workbook and Worksheet and Database object
Set appExcel = New Excel.Application
'appExcel.Visible = True
'appExcel.DisplayAlerts = False
Set wbk = appExcel.Workbooks.Open(sOutput)
Set wks = appExcel.Worksheets(cTabTwo)
Periode_var = Modifiable5.Value
sSQL = "SELECT " & Periode_var & "A, Nom, Cat" & Periode_var & "A FROM Planif WHERE Cat" & Periode_var & "A > 0 ORDER BY Cat" & Periode_var & "A ASC "
Set dbs = CurrentDb
Set rst = dbs.OpenRecordset(sSQL, dbOpenSnapshot)
If Not rst.BOF Then rst.MoveFirst
' For this template, the data must be placed on the 4th row, third column.
' (these values are set to constants for easy future modifications)
iCol = cStartColumn
iRow = cStartRow
'''''''''''''''''''''''''''''''''''''
wks.Names.Add Name:="Tablo", RefersTo:="=DECALER(Feuil2!$B$6;;;NBVAL(Feuil2!$B$6:$B$5000);5)"
'ActiveWorkbook.Worksheets("Feuil1").Names("tablo111").Comment = ""
'''''''''''''''''''''''''''''''''''''
'Stop
Do Until rst.EOF
'iFld = 0
lRecords = lRecords + 1
'Me.lblMsg.Caption = "Exporting record #" & lRecords & " to Stage1.xls"
Me.Repaint
For iCol = cStartColumn To cStartColumn + (rst.Fields.Count - 1)
wks.Cells(iRow, "B") = rst.Fields(0)
wks.Cells(iRow, "B").WrapText = False
wks.Cells(iRow, "C") = rst.Fields(1)
wks.Cells(iRow, "C").WrapText = False
wks.Cells(iRow, "F") = rst.Fields(2)
wks.Cells(iRow, "F").WrapText = False
Next
wks.Rows(iRow).EntireRow.AutoFit
' wks.Range("B" & iRow & ":E" & iRow).Borders.LineStyle = xlContinuous
iRow = iRow + 1
rst.MoveNext
Loop
sSQL = "SELECT " & Periode_var & "B, Nom, Cat" & Periode_var & "B FROM Planif WHERE Cat" & Periode_var & "B > 0 ORDER BY Cat" & Periode_var & "B ASC "
Set dbs = CurrentDb
Set rst = dbs.OpenRecordset(sSQL, dbOpenSnapshot)
'Stop
Do Until rst.EOF
'iFld = 0
lRecords = lRecords + 1
'Me.lblMsg.Caption = "Exporting record #" & lRecords & " to Stage1.xls"
Me.Repaint
For iCol = cStartColumn To cStartColumn + (rst.Fields.Count - 1)
wks.Cells(iRow, "B") = rst.Fields(0)
wks.Cells(iRow, "B").WrapText = False
wks.Cells(iRow, "D") = rst.Fields(1)
wks.Cells(iRow, "D").WrapText = False
wks.Cells(iRow, "F") = rst.Fields(2)
wks.Cells(iRow, "F").WrapText = False
Next
wks.Rows(iRow).EntireRow.AutoFit
' wks.Range("B" & iRow & ":E" & iRow).Borders.LineStyle = xlContinuous
iRow = iRow + 1
rst.MoveNext
Loop
appExcel.Run "Fusionner"
''''''''''''''''''''''''''''''''''''''''''''
sSQL = "SELECT Categorie, Catindex FROM Catvaleur"
Set dbs = CurrentDb
Set rst = dbs.OpenRecordset(sSQL, dbOpenSnapshot)
'Stop
Do Until rst.EOF
lRecords = lRecords + 1
Me.Repaint
For iCol = cStartColumn To cStartColumn + (rst.Fields.Count - 1)
wks.Cells(iRow, "B") = rst.Fields(0)
wks.Cells(iRow, "B").WrapText = False
wks.Cells(iRow, "F") = rst.Fields(1)
wks.Cells(iRow, "F").WrapText = False
If rst.Fields(1) = "0,1" Then
wks.Range("B" & iRow).Interior.Color = RGB(244, 176, 132)
ElseIf rst.Fields(1) = "1,2" Then
wks.Range("B" & iRow).Interior.Color = RGB(155, 194, 230)
ElseIf rst.Fields(1) = "2,3" Then
wks.Range("B" & iRow).Interior.Color = RGB(255, 192, 0)
ElseIf rst.Fields(1) = "3,4" Then
wks.Range("B" & iRow).Interior.Color = RGB(169, 208, 142)
End If
Next
wks.Rows(iRow).EntireRow.AutoFit
' wks.Range("B" & iRow & ":E" & iRow).Borders.LineStyle = xlContinuous
iRow = iRow + 1
rst.MoveNext
Loop
'wks.Range("F6").End(xlDown).Select
wks.Sort.SortFields.Clear
wks.Sort.SortFields.Add Key:=Range("F6"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With wks.Sort
.SetRange Range("B6:F300")
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
derl = Range("F6").End(xlDown).Row
wks.Range("B6:E" & derl).Borders.LineStyle = xlContinuous
appExcel.DisplayAlerts = False
wbk.SaveAs CurrentProject.Path & "\Stage1.xlsm"
ExportRequest = "Total de " & lRecords & " lignes traitées."
'Quitte Excel
'wbk.Close (True)
'Libère la mémoire
' Set wks = Nothing
' wbk.Close savechanges:=False
' appExcel.Quit
' Set wbk = Nothing
' Set appExcel = Nothing
Dim sKill As String
sKill = "TASKKILL /F /IM excel.exe"
Shell sKill, vbHide
exit_Here:
' Cleanup all objects (resume next on errors)
On Error Resume Next
Set wks = Nothing
'wbk.Close savechanges:=True
Set wbk = Nothing
Set appExcel = Nothing
' sKill = "TASKKILL /F /IM excel.exe"
' Shell sKill, vbHide
Set rst = Nothing
Set dbs = Nothing
DoCmd.Hourglass False 'icone tablier a false
Exit Function
err_Handler:
ExportRequest = Err.Description
Resume exit_Here
End Function
答案 0 :(得分：1)
这通常是由不合格的对象引起的：
“Visual Basic已建立对Excel的引用，因为调用Excel对象，方法或属性的代码行没有使用Excel对象变量限定元素。在您结束程序之前，Visual Basic不会释放此引用当代码运行多次时，这个错误的引用会干扰自动化代码。“ [https://support.microsoft.com/en-us/help/178510/excel-automation-fails-second-time-code-runs]
快速查看代码，我会在此部分代码中看到不合格的范围，因此请尝试限定范围，例如wks.Range（“F6”）等。
wks.Sort.SortFields.Add Key:=Range("F6"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With wks.Sort
.SetRange Range("B6:F300")
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
derl = Range("F6").End(xlDown).Row
答案 1 :(得分：1)
首先，我相信您已经遇到了此处描述的情况，即使您当然没有使用文章提到的某个Excel版本：Excel automation fails second time code runs。文章中的关键句是
Visual Basic已经建立了对Excel的引用，因为一行代码调用了Excel对象，方法或属性，而没有使用Excel对象变量限定元素。
快速检查您的代码会显示以下内容：
derl = Range("F6").End(xlDown).Row
请注意，您Range未对wks.进行限定。您的代码中可能会出现其他不合格的引用;我会让你仔细检查。
然后，以下是关闭Excel会话的方法：
'Release child objects, then their parents, etc.
Set wks = Nothing
wbk.Close SaveChanges:=False
Set wbk = Nothing
appExcel.Quit
Set appExcel = Nothing
原则是释放最深的＆＃34;首先是对象，然后沿着层次结构向上移动到应用程序本身，退出并最终释放它。
不要忘记删除任务查杀shell调用。