Microsoft Access 掲示板

■DoCmdエクスポートのコードです～シート3のみが保存されてシート１・２は消えてしまいました。
Function エクセルへエクスポート()

 Dim strSaveBookPath As String
 Dim xls As Object
  'テンプレートの保存先フォルダ
  Const cstrTemplateDir As String = "\SV30**\metal2*課\HDD\リフォーム見積りDB\見積書\"
  'テンプレートのファイル名
  Const cstrTemplateBook As String = "RF見積書.xlsx"
  'データが代入されたファイルの保存先フォルダ
  Const cstrSaveBookDir As String = "\SV30\metal*2****課\HDD\リフォーム見積りDB\見積書\"
  On Error GoTo エクセルへエクスポート_Err

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

On Error GoTo エクセルへエクスポート_Err

    DoCmd.TransferSpreadsheet acExport, 10, "Q_見積明細1_P", "\SV30**\metal2*課\HDD\リフォーム見積りDB\見積書.xlsx", True, "Sheet1"
    DoCmd.TransferSpreadsheet acExport, 10, "Q_明細2_R", "\SV30\metal*2*課\HDD\リフォーム見積りDB\見積書.xlsx", True, "Sheet2"
    DoCmd.TransferSpreadsheet acExport, 10, "Q_明細3_R", "\SV30\metal*2****課\HDD\リフォーム見積りDB\見積書.xlsx", True, "Sheet3"

       '保存するファイル名のフルパスを組み立て
    .strSaveBookPath = cstrSaveBookDir & "見積書_" & Format$(Forms!F_見積!物件名) & ".xlsx"

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

   '画面の再描画を元に戻す
    .ScreenUpdating = True

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

    MsgBox "データを保存しました"

    'Excelを終了
    .Quit

  End With

  Set xls = Nothing

エクセルへエクスポート_Exit:
    Exit Function

エクセルへエクスポート_Err:
    MsgBox Error$
    Resume エクセルへエクスポート_Exit

End Function