Microsoft Access 掲示板

いつもお世話になっております。

https://tsware.jp/tips/tips_689.htm　
様のサンプルコードを利用しているのですが、
エクセル作成以降でエラーが起こったとき不具合が起きます。
具体的には、シャットダウン時にエクセルが保存されていないというようなダイアログが出て、
それをデスクトップなりなんなりに保存しないと進まないし、それを削除しようとすると
ほかのユーザーが使用しているので削除できませんとされてしまいます。（再起動後に削除可能)

エラートラップが間違っているのだと思いますが、どうしていいのかがわかりません。
くだんのサイト様のコードをベースに再現したものを下記に添付します。

On Error GoTo ErrHandler
  Dim dbs As Database
  Dim rst As Recordset
  Dim xls As Object
  Dim intRow As Integer
  Dim lngOrderID As Long
  Dim strSaveBookPath As String
  'テンプレートの保存先フォルダ
  Const cstrTemplateDir As String = "C:\テスト\"
  'テンプレートのファイル名
  Const cstrTemplateBook As String = "受注伝票テンプレート.xlsx"
  'データが代入されたファイルの保存先フォルダ
  Const cstrSaveBookDir As String = "C:\テスト\"

  'データ元のクエリを開く
  Set dbs = CurrentDb
  Set rst = dbs.OpenRecordset("qsel受注伝票")

  'Excelオブジェクトを生成
  Set xls = CreateObject("Excel.Application")
  With xls
    '画面の再描画を抑止
    .ScreenUpdating = False
    'テンプレートファイルを開く
    .Workbooks.Open cstrTemplateDir & cstrTemplateBook
    'ワークシートをコピー
    .Workbooks(cstrTemplateBook).Worksheets("Sheet1").Copy
    'テンプレートファイルを閉じる
    .Workbooks(cstrTemplateBook).Close

'' エラー強制発行
    Err.Raise Number:=6
  
    '１レコード目から受注IDと得意先情報を代入
    lngOrderID = rst!受注ID
    .Cells(4, 2).Value = lngOrderID
    .Cells(5, 2).Value = rst!得意先ID
    .Cells(6, 2).Value = "〒" & rst!郵便番号 & "  " & rst!住所
    .Cells(7, 2).Value = rst!会社名
    .Cells(4, 7).Value = Date

    '商品明細の全レコードをループで各セルに代入
    intRow = 10
    Do Until rst.EOF
      .Cells(intRow, 1).Value = rst!商品コード
      .Cells(intRow, 2).Value = rst!商品名
      .Cells(intRow, 5).Value = rst!数量
      .Cells(intRow, 6).Value = rst!販売単価
      .Cells(intRow, 7).Value = rst!金額
      intRow = intRow + 1
      rst.MoveNext
    Loop
    rst.Close

    '保存するファイル名のフルパスを組み立て
    strSaveBookPath = cstrSaveBookDir & "受注伝票_" & Format$(lngOrderID, "00000") & ".xlsx"

    '同名ファイルを強制削除
    On Error Resume Next
    Kill strSaveBookPath
    On Error GoTo 0

    'データを代入したブックを保存
    .ActiveWorkBook.SaveAs strSaveBookPath

    '画面の再描画を元に戻す
    .ScreenUpdating = True
    'Excelを終了
    .Quit

  End With
  
ExitHere:
    Set xls = Nothing
    Exit Sub

ErrHandler:
    MsgBox Err.Number & Err.Description
Resume ExitHere

End Sub