第二次运行VBA代码时，出现“运行时错误462：远程服务器计算机不存在或不可用”

Question

The code below is working fine the first time I run it, but when I need to run it a second time, it gives me this error:

Run Time error '462': the remote server machine does not exist or is unavailable

It does happen all the time and i've fight against background excel instance so maybe it's something like that...? What am I missing here?

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

Answer 1

This is usually caused by unqualified objects:

"Visual Basic has established a reference to Excel because of a line of code that calls an Excel object, method, or property without qualifying the element with an Excel object variable. Visual Basic does not release this reference until you end the program. This errant reference interferes with automation code when the code is run more than one time." [ https://support.microsoft.com/en-us/help/178510/excel-automation-fails-second-time-code-runs]

On a quick look through your code I see unqualified Ranges in this section of code, so try qualifying the ranges eg wks.Range("F6") etc.

 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

Answer 2

First, I believe you're running into the situation described here, even though you're certainly not using one of the Excel versions the article mentions: Excel automation fails second time code runs . The key sentence in the article is

Visual Basic has established a reference to Excel because of a line of code that calls an Excel object, method, or property without qualifying the element with an Excel object variable.

A quick inspection of your code reveals this line:

derl = Range("F6").End(xlDown).Row

Notice that you haven't qualified Range with wks. . There might be other occurrences of unqualified references in your code; I'll let you double-check.

Then, here's how you should be closing the Excel session:

'Release child objects, then their parents, etc.
Set wks = Nothing
wbk.Close SaveChanges:=False
Set wbk = Nothing
appExcel.Quit
Set appExcel = Nothing

The principle is to release the "deepest" objects first and walk your way up the hierarchy to the application itself, quit it and finally, release it.

Don't forget to remove the task killing shell call.