Learn how to a build a cloud-first strategyRegister Now

x
?
Solved

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

Posted on 2012-09-21
4
Medium Priority
?
1,546 Views
Last Modified: 2012-10-02
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

0
Comment
Question by:Karen Schaefer
  • 3
4 Comments
 
LVL 85
ID: 38424462
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
0
 

Author Comment

by:Karen Schaefer
ID: 38429080
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.
option Group
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
0
 

Accepted Solution

by:
Karen Schaefer earned 0 total points
ID: 38442101
Close - found another approach - reverted back to deleting all worksheet's data and changing the quit from xls.quit xls.application.quit.
0
 

Author Closing Comment

by:Karen Schaefer
ID: 38453822
please close
0

Featured Post

Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Code that checks the QuickBooks schema table for non-updateable fields and then disables those controls on a form so users don't try to update them.
Sometimes MS breaks things just for fun... In Access 2003, only the maximum allowable SQL string length could cause problems as you built a recordset. Now, when using string data in a WHERE clause, the 'identifier' maximum is 128 characters. So, …
Many functions in Excel can make decisions. The most simple of these is the IF function: it returns a value depending on whether a condition you describe is true or false. Once you get the hang of using the IF function, you will find it easier to us…
With Secure Portal Encryption, the recipient is sent a link to their email address directing them to the email laundry delivery page. From there, the recipient will be required to enter a user name and password to enter the page. Once the recipient …

810 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question