Leaving open instances of Excel after SaveAs

[Sketchin]

I have some code that opens and populates an Excel spreadsheets then does a save as to a specific directory and also outputs a PDF. This code is working with one small problem, I am leaving the first instance of Excel open and can't figure out where I should put the code for it to quit. Here is my code:

' This code creates a recordset based on the current reservation in order to gather data on
' a specific reservation, to output to a payment schedule excel spreadsheet which calculates
' Payment dates and amounts for specific reservations


' Declare variables for recordset
Dim rst As DAO.Recordset
Dim db As DAO.Database
Dim LeaseCost As Double
Dim DateOut As Date
Dim DateIn As Date
Dim Company As String
Dim ReservationNumber As Double
Dim reservationNumberforForm As String
Dim Filename As String
Dim FilenamePDF As String

'Constants for output of PDF
Const xlTypePDF = 0
Const xlQualityStandard = 0



' Use the first 2 contact variables for first and last name and the final one for the combination of the 2
Dim ContactFirst As String
Dim ContactLast As String
Dim Contact As String

Set db = CurrentDb()
' SQL statement to select appropriate reservations
strSQL = "SELECT tblReservations.[ReservationNumber], tblReservations.[DateOutReq], tblReservations.[DateInReq], Contacts.[Last Name], " & _
        "Contacts.[First Name], tblCompanies.[CompanyName], tblReservations.[ReservationID] " & _
        "FROM ((tblCompanies INNER JOIN Contacts ON tblCompanies.CompanyID = Contacts.[CompanyID]) " & _
        "INNER JOIN tblReservations ON (tblCompanies.[CompanyID] = tblReservations.[CompanyID]) AND " & _
        "(Contacts.ID = tblReservations.[ContactID])) INNER JOIN tblReservation_details ON " & _
        "tblReservations.[ReservationID] = tblReservation_details.[ReservationID]" & _
        "WHERE (((tblReservations.[ReservationID])=" & [Forms]![FrmReservations]![TxtReservationID] & " ))"

Set rst = db.OpenRecordset(strSQL, dbOpenDynaset)

'If recordset is empty, exit
Do While Not rst.EOF

'Assign values to variables

        DateOut = Nz(rst.Fields("[DateoutReq]"))
        DateIn = Nz(rst.Fields("[DateInReq]"))
        LeaseCost = Forms!FrmReservations!SubfrmReservation_Details!txtleaseSubtotal
        Company = Nz(rst.Fields("[CompanyName]"))
        ContactFirst = Nz(rst.Fields("[First Name]"))
        ContactLast = Nz(rst.Fields("[Last Name]"))
        ReservationNumber = Nz(rst.Fields("[ReservationNumber]"))
        reservationNumberforForm = "RES-00" & ReservationNumber
        ' Combine first and last name for the contact
        Contact = ContactFirst & " " & ContactLast

rst.MoveNext
Loop

Dim spath As String
Dim xlApp As Excel.Application
Set xlApp = CreateObject("Excel.Application")

With xlApp
'Open Excel sheet
  [COLOR="Red"]  .Workbooks.Open ("S:\Programs\WD Geomatics Lab\Reservations\Lease Amortization Worksheet.xlsx")[/COLOR]
    .Sheets("PMT").Select
    .Range("C1") = Company
    .Range("C2") = reservationNumberforForm
    .Range("C3") = Contact
    .Range("F7") = DateOut
    .Range("F8") = DateIn
    .Range("F9") = LeaseCost
    
  'Build path to save file to
    spath = "S:\Contracts\Geomatics LAB\Signed\" & Company
     If Dir(spath, vbDirectory) = "" Then
        MkDir (spath)
    Else
     MsgBox "Saving to existing directory"
    End If

  'Build File name
  Filename = "" & reservationNumberforForm & " " & Company & "-Payment Schedule" & ".xlsx"
  FilenamePDF = "" & reservationNumberforForm & " " & Company & "-Payment Schedule" & ".pdf"
       
'Trying to figure out how to check for an existing filename
    
     If Not FileExists((spath & Filename)) Then
            
            'Save the payment schedule to the S: drive
            
            'Save a PDF
            .Sheets("PMT").Select
            .Sheets("PMT").Copy
            .ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=FilenamePDF _
            , Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
            :=False, OpenAfterPublish:=True

            xlApp.ActiveWorkbook.SaveAs Filename:="" & spath & "\" & " " & Filename, FileFormat:=xlOpenXMLWorkbook
            xlApp.ActiveWorkbook.Saved = True
            MsgBox "File Saved to:" & " " & "S:\Contracts\Geomatics LAB\Signed\" & Company
            .Quit
            Set xlApp = Nothing
            Else
        
             On Error Resume Next
             If Err.Number = 1004 Then
             On Error GoTo 0
             Else
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Pretty sure this is redundant
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

            'Save PDF
            .Sheets("PMT").Select
            .Sheets("PMT").Copy
            .ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=FilenamePDF _
            , Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
            :=False, OpenAfterPublish:=True

            'Save the payment schedule to the S: drive
             xlApp.ActiveWorkbook.SaveAs Filename:="" & spath & "\" & " " & Filename, FileFormat:=xlOpenXMLWorkbook
             xlApp.ActiveWorkbook.Saved = True
             MsgBox "File Saved to:" & " " & "S:\Contracts\Geomatics LAB\Signed\" & Company
                .Quit
            Set xlApp = Nothing
           
            End If
     End If
    
'Housekeeping
'xlApp.Quit
'Set xlApp = Nothing
'
'Close the recordset
rst.Close
Set rst = Nothing
Set db = Nothing
Set oOApp_001 = Nothing
End With

End Sub

The instance that I need to close is shown in red. Thanks for the help!

 

[Mr. B]

This problem occurs when you do not use fully qualified instances of the various Excel objects.

Take a look at this thread:
http://www.access-programmers.co.uk...highlight=code+leaving+instance+of+excel+open

There is a link in that thread to this:
http://www.btabdevelopment.com/ts/excelinstance

This should provide you with the solution.