Run Time Error 9 , trying to save Excel file, on 2nd time through loop (1 Viewer)

[heron_rider]

Hello Forum,

I am getting Run Time Error 9: Subscript out of range in an Access VBA project I am working on. The project is designed to write data (or a message saying there is no data) from query results to 6 tabs in a preformatted Excel file. The 6 tabs correspond to 6 different categories of of the entity I am covering. The code seems to work on the first time through (1st category/1st tab) and also on the 2nd time through (open the recordset, opens the Excel file, writes the data to the cells)then refuses to save the file.
I have checked spellings. From the searching I have done, I think it is a problem with what workbook is active. I have tried multiple methods all to no avail.

The offending line is:
'*****the next line crashes on 2nd time through****************
Workbooks("C:\UCMR3\2003 Draft SMP Master Template John.xls").Save


Here is the code (this is my 1st post, not sure what the code posting ettiquette, please forgive any faux pas)

Option Compare Database
Option Explicit

'sub will gather records by stepping through 2 lookup tables and export to Excel
Public Sub MakeSMP()

Dim db As Database
Dim strPrCall As String
Dim strReCall As String
Dim strState As String
Dim strSource As String
Dim strSize As String
Dim rstDataPr As dao.Recordset
Dim rstDataRe As dao.Recordset
Dim rs1 As adodb.Recordset 'use this for state look up
Dim rs2 As adodb.Recordset 'use this for size/source look up
Dim xlsObject As Object
Dim PWS As String
Dim lngRow As Long
Dim intCol As Integer
Dim strCell As String
Dim intI As Integer
Dim strTest As String
Dim intPCount As Integer
Dim strCat  'combine size and source into a category
Dim Destwb As Workbook 'Draft SMP file
Dim strFileName As String 'to construct draft SMP file name
Dim strPath As String  ' this is where the draft SMP are saved S:\UCMR\UCMR3\SMPs\L1 Draft SMP data
Dim qrydefPr As dao.QueryDef

Set db = CurrentDb()
Set rs1 = New adodb.Recordset
rs1.Open "tblStateLookUp", CurrentProject.Connection, adOpenKeyset, adLockOptimistic, adCmdTableDirect
Set rs2 = New adodb.Recordset
rs2.Open "tblSizeSourceLookUp", CurrentProject.Connection, adOpenKeyset, adLockOptimistic, adCmdTableDirect


rs1.MoveFirst
strState = rs1![State]
rs2.MoveFirst
strSource = rs2![Source]
strSize = rs2![Size]
strCat = strSource & strSize
MsgBox "Category is " & strCat

Do 'This is the Size/Source Loop
   'Next 5 lines calls the query for the primary systems
    Set qrydefPr = db.QueryDefs("qryL1PrimarySelectSMPDataCalled")
    qrydefPr.Parameters!State = strState
    qrydefPr.Parameters!PWSSize = strSize
    qrydefPr.Parameters!PWSSource = strSource
    Set rstDataPr = qrydefPr.OpenRecordset(dbOpenDynaset)

If Not (rstDataPr.BOF And rstDataPr.EOF) Then 'There are no records if Beginning-Of-File and End-Of-File are both true.
    rstDataPr.MoveLast
    intPCount = rstDataPr.RecordCount
    MsgBox "There are " & intPCount & " records for this category"
    Set xlsObject = New Excel.Application
        xlsObject.Workbooks.Open FileName:="C:\UCMR3\2003 Draft SMP Master Template John.xls" 'Formatted
        'xlsObject.Workbooks.Open FileName:="S:\UCMR\UCMR3\SMPs\Draft SMP Master Template John.xlsx" 'Formatted
        'xlsObject.Workbooks.Open Filename:="S:\UCMR\UCMR3\SMPs\Draft SMP Master Template Unformatted.xlsx" 'UnFormatted
        xlsObject.Visible = True
        lngRow = 5
        rstDataPr.MoveFirst
            Do Until rstDataPr.EOF 'This loop writes one or more SMP records
                PWS = strCat
                'This selects the worksheet in the workbook you want to add data to
                Select Case PWS
                    Case "GWVS"
                        xlsObject.Sheets("Very Small GW").Select
                    Case "GWS"
                        xlsObject.Sheets("Small GW").Select
                    Case "GWM"
                        xlsObject.Sheets("Medium GW").Select
                    Case "SWVS"
                        xlsObject.Sheets("Very Small SW").Select
                    Case "SWS"
                        xlsObject.Sheets("Small SW").Select
                    Case "SWM"
                        xlsObject.Sheets("Medium SW").Select
                End Select

        
        With xlsObject
            For intCol = 2 To 15
                intI = intCol - 2
                    With .ActiveSheet.Cells(lngRow, intCol)
                    .Font.Name = "Arial Black"
                    .Font.Size = 10
                    .Value = rstDataPr(intI)
                     
                    End With
            Next intCol
                        
                        'Workbooks("C:\UCMR3\2003 Draft SMP Master Template John.xls").Activate
                        '*****the next line crashes on 2nd time through****************
                        Workbooks("C:\UCMR3\2003 Draft SMP Master Template John.xls").Save
                        lngRow = lngRow + 1
                        'Workbooks("Draft SMP Master Template John.xlsx").Save
                        MsgBox "Woohooo The code got here"
                        xlsObject.Quit
                        Set xlsObject = Nothing
                rstDataPr.MoveNext
                If rstDataPr.EOF = True Then
                      'MsgBox ActiveWorkbook.Name
                       Exit Do
                End If

        End With
                          
            Loop 'End of do to write records
                If rs2.EOF = True Then
                    Exit Do
                Else
                    rs2.MoveNext
                    strSource = rs2![Source]
                    strSize = rs2![Size]
                    strCat = strSource & strSize
                    MsgBox "Category is " & strCat & " " & "Moving From the one or more records loop"
                End If
                        
        rstDataPr.Close
        Set rstDataPr = Nothing
Else
            
    MsgBox "There are " & 0 & " records for this category"
    Set xlsObject = New Excel.Application
        xlsObject.Workbooks.Open FileName:="C:\UCMR3\2003 Draft SMP Master Template John.xls" 'Formatted
        'xlsObject.Workbooks.Open FileName:="S:\UCMR\UCMR3\SMPs\Draft SMP Master Template John.xlsx" 'Formatted
        'xlsObject.Workbooks.Open Filename:="S:\UCMR\UCMR3\SMPs\Draft SMP Master Template Unformatted.xls" 'UnFormatted
        xlsObject.Visible = True
        lngRow = 5
        PWS = strCat
            'This selects the worksheet in the workbook you want to add data to
            Select Case PWS
                Case "GWVS"
                    xlsObject.Sheets("Very Small GW").Select
                Case "GWS"
                    xlsObject.Sheets("Small GW").Select
                Case "GWM"
                    xlsObject.Sheets("Medium GW").Select
                Case "SWVS"
                    xlsObject.Sheets("Very Small SW").Select
                Case "SWS"
                    xlsObject.Sheets("Small SW").Select
                Case "SWM"
                    xlsObject.Sheets("Medium SW").Select
            End Select
        With xlsObject
            For intCol = 2 To 2
            intI = intCol - 2

            With .ActiveSheet.Cells(lngRow, intCol)
            .HorizontalAlignment = xlLeft
            .Font.Name = "Arial Black"
            .Font.Size = 16
            End With
            .ActiveCell.Value = "There are no systems in this category"
            MsgBox ActiveWorkbook.Name
            Workbooks("2003 Draft SMP Master Template John.xls").Save
            xlsObject.Quit
            Set xlsObject = Nothing
            Next intCol
        End With
            
    If rs2.EOF = True Then
        Exit Do
    Else
        rs2.MoveNext
        strSource = rs2![Source]
        strSize = rs2![Size]
        strCat = strSource & strSize
        MsgBox "Category is " & strCat & " " & "Moving From the zero records loop"
    End If
    rstDataPr.Close
    Set rstDataPr = Nothing
End If


Loop Until rs2.EOF 'This is the end of the Size/Source Do
strFileName = rs1.[State] & "Draft SMP"
strPath = "S:\UCMR\UCMR3\SMPs\L1 Draft SMP data"


    With Destwb
        .SaveAs strPath & strFileName & ".xlsx"
        
    End With
End Sub

 

[JANR]

This might help :http://www.btabdevelopment.com/ts/excelinstance

JR

 

[heron_rider]

Thanks for the link, that did help. However, it did not get me all the way there. It seems SaveAs is more reliable than Save.

I changed both instances of:

Workbooks("2003 Draft SMP Master Template John.xlsx").Save

to:

xlsTemplate.SaveAs FileName:="S:\UCMR\UCMR3\SMPs\Draft SMP Master Template John.xlsx"

Works perfect! No onto the hard part of the project