asked on

Subscript out of Range Exporting data to Excel workSheet within a workbook from Access

I need to modify the following code to ask the user for each worksheet within a workbook which needs to be updated or cleared prior to updating the worksheet

Note this code is called as part of a group of code that will update the data within the workbook. so should I insert code to question of the worksheets need to be update prior to running the DeleteWkSht() and modify the DeleteWkSht to only delete a specified worksheet -

With the current code I am getting Subscript out of range error and multiple instances of Excel are left open - have to use Task Manger to force close. How do I eliminate the multiple instances and prevent error?

thanks,
K

Function DeleteWkSht(nQryName As String)
Dim xlApp As Object
Dim xlWb As Object
Dim xlWs As Object
Dim nFileName As String
 
nFileName = DLookup("FilePath", "tblFilePath")
nFileName = Mid([nFileName], InStr([nFileName], "#") + 1, Len([nFileName]) - InStr([nFileName], "#") - 1)

   On Error GoTo DeleteWkSht_Error

     Set xlApp = CreateObject("Excel.Application")

     Set xlWb = xlApp.Workbooks.Open(nFileName)

     Set xlWs = xlApp.Worksheets(nQryName)
     
        For Each xlWs In xlWb.Worksheets
            xlWs.cells.ClearContents
        Next xlWs

    xlWb.Close SaveChanges:=True
    
    xlApp.Quit

    Set xlApp = Nothing
                                            

   On Error GoTo 0
   Exit Function

DeleteWkSht_Error:

    MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure DeleteWkSht of Module modFunctions"

End Function

Open in new window

Scott McDaniel (EE MVE )

As we've asked many times in the past: Please post the LINE where the error is occurring.

I'm not sure what your goal is with this. Do you want to DELETE a Worksheet in an Excel Workbook, or are you trying to MODIFY data in an existing worksheet? Your code does not DELETE a worksheet, it just clears the contents of a worksheet. Is that what you intend to do?

Also, do you want to DELETE a specific sheet in the Workbook? You're setting your xlWs object to (supposedly) a specific sheet, but they you appear to loop through all the other worksheets:

For Each xlWs In xlWb.Worksheets
xlWs.cells.ClearContents
Next xlWs

What's the point of looping through all the worksheets AFTER you've set the xlWs object to a specific sheet.

Are the Worksheets all in the SAME Workbook, or would you have to open new Workbooks for each Worksheet? Looks like they're in different WorkBooks, but it's not clear from your question.

Finally: Try setting all Object variables to Nothing before you close out the process:

Set xlWs = Nothing
Set xlWb = Nothing
Set xlApp = Nothing

Karen Schaefer

ASKER

The user has a form with the Access database containing an option group and Date Range, depending on which option the user selects determine which Excel worksheet will need to be cleared of old data and then updated with the latest data. Hence the setting of the WorkSheet name from a variable.

They can select one or many of the options.

The above mentioned function is called from another set of code as
DeleteWkSht (nQryName)
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, _
"TempQry", nFileName, True, nQryName

If the query Recordcount >0 then I need to clear and update the data, without effecting the other worksheets within the workbook.

However, it seems to want to keep multiple copies of Excel open for each pass of the code, hence the "Script out of Range" message.

Here is the first part of my code where I am calling the function, This type of code is repeated for each of the options within this code only changing the query name, and variables used for the particular option in question. See '<<<<<<<<<<<<<<<<<<<<<<<<<<

Private Sub cmdFilter_Click()

    Dim nBDate As Date
    Dim nEDate As Date
    Dim nQry As String
    Dim nQryName As String
    Dim strSQL As String
    Dim strSql1 As String
    Dim strWhere As String
    Dim strOrderBy As String
    Dim rs, rs1 As Recordset
    Dim qdf As QueryDef
    Dim xlApp As Object
    Dim xlWb As Object
    Dim xlWs As Object
    Dim Counter As Long
    Dim nFileName As String
    
   On Error GoTo cmdFilter_Click_Error
 
nFileName = DLookup("FilePath", "tblFilePath")
nFileName = Mid([nFileName], InStr([nFileName], "#") + 1, Len([nFileName]) - _
    InStr([nFileName], "#") - 1)

Set curDB = CurrentDb()

checkFile (nFileName)
    
    DoCmd.OpenForm "frmMessage", acNormal, , , acFormReadOnly, acWindowNormal, _
        OpenArgs:=Me.Name
    Forms!frmMessage.lblMsg.Caption = _
        "PLEASE WAIT WHILE THE SYSTEM RETRIEVES THE DATA TO BE EXPORTED TO EXCEL."
    
    DoCmd.RepaintObject acForm, "frmMessage"

    curDB.Execute ("Delete * from tblQryBasedData")
    'Sets Start & End dates for reporting export data
    If Me.Start_Date <> "" Or Me.End_Date <> "" Then
        gStart = Format(Me.Start_Date, "Short Date")
        gEnd = Format(Me.End_Date, "Short Date")
    Else
        Call _
            MsgBox("Please enter a Start & Ending dates prior to processing your request.", _
            vbExclamation, "Data Missing")
            Me.Start_Date.SetFocus
            Exit Sub
    End If

   'Compiles School information for selected schools
    Forms!frmMessage.lblMsg.Caption = _
        "PLEASE WAIT WHILE THE SYSTEM RETRIEVES THE SCHOOL DATA TO BE EXPORTED TO EXCEL."
    DoCmd.RepaintObject acForm, "frmMessage"
 
    If Me.chkSchool = -1 Then
    
        gSchoolId = vbNullString
        
        With Me.lstSchoolSearch
            If .ItemsSelected.Count > 0 Then
              For Each i In .ItemsSelected
                  gSchoolId = .ItemData(i) & ", " & gSchoolId
              Next i
                  gSchoolId = Left(gSchoolId, Len(gSchoolId) - 2)
            End If
        End With
         
        strSQL = "Select SchoolNameRecID, DateModified from tblSchoolInfo"
        strWhere = " WHERE SchoolNameRecID IN(" & gSchoolId & ")"
        
        If strWhere = "" Then
            strWhere = " WHERE DateModified Between " & "#" & gStart & "#" & _
                " and " & "#" & gEnd & "#" & ""
        Else
            strWhere = strWhere & " and DateModified Between " & "#" & gStart & _
                "#" & " and " & "#" & gEnd & "#" & ""
        End If
        
        strSQL = strSQL & strWhere
        
        strSql1 = "Select * from tblQryBasedData"
        Set rs1 = curDB.OpenRecordset(strSql1)
        Set rs = curDB.OpenRecordset(strSQL)
        Do Until rs.EOF
            rs1.AddNew
                rs1.Fields("SchoolNameRecID") = rs.Fields("SchoolNameRecID")
                rs1.Fields("DateModified") = rs.Fields("DateModified")
            rs1.Update
        rs.MoveNext
        Loop
         
         nQry = "QrySchoolinfo"
         nQryName = "SchoolInfo"
        
        strSQL = "SELECT * FROM  " & nQry & ""
        
        Set qdf = curDB.QueryDefs("TempQry")
        qdf.SQL = strSQL
        qdf.Close
        If DCount("*", "TempQry") > 0 Then
            DeleteWkSht (nQryName)'<<<<<<<<<<<<<<<<<<<<<<<<<<
            DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, _
                "TempQry", nFileName, True, nQryName
        Else
            Call MsgBox("Your current request has returned " & nQryName & _
                " No Data.", vbExclamation, "No Data Found")
            
        End If
       
    End If

Open in new window

I hope this clarified things better.

K

ASKER CERTIFIED SOLUTION

Karen Schaefer

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

Karen Schaefer

ASKER

please close