1004: Application-defined or object-defined error (1 Viewer)

[tranchemontaigne]

I've got a block of code that inconsistently generates the following error when exporting data to MS Excel.

ENVIRONMENT
MS Access 2000
Windows XP

METHOD
(1) VBA module connects directly to an Oracle 11g back end table and creates a recordset.
(2) Record set results are used to populate an array (type variant).
(3) Array results are divided so that each element of the array stores a value intended to be written to individual cells in an MS Excel worksheet
(4) A 'matrix transposition' occurs and array values are written to individual cells in an MS Excel worksheet. This is where the run-time error is generated.

When larger recordsets are defined for export I encounter error "1004: Application-defined or object-defined error". Error should not be an overflow problem as I have code that stops export operations if more than 2000 Oracle records are identified for export to MS Excel.

This method is used to export data because it is fast and should be error independent.

Where are things going wrong? Any tips on resolving the error.

Public Function fnExportToExcel_ADO(strSQL As String, _
    Optional ByRef lnX As Long = 1, _
    Optional ByRef lnY As Long = 1, _
    Optional ByRef lnN As Long = 1, _
    Optional ByRef lnM As Long = 1, _
    Optional blHeaders As Boolean = True) As Worksheet
'//////////////////////////////////////////////////////////////////
'// Function: fnExportToExcel_ADO
'//////////////////////////////////////////////////////////////////
'// Author: Tranchemontaigne
'//     Based upon code created by Andrew Semenov and retreived in
'//     2003 from http://www.zmey.1977.ru/Access_To_Excel.htm
'//////////////////////////////////////////////////////////////////
'//   Modified:
'//     Date        Editor        Description
'// ===============================================================
'//     XX XXX 2003 Tranchemontaigne  -Created
'//     25 Aug 2009 Tranchemontaigne  -Adopted for Death database
'//     28 Dec 2012 Tranchemontaigne  -Added error handling
'//     26 Feb 2013 Tranchemontaigne  -Modified to use a direct
'//                                connection to Oracle
'//                               -Improved no records found error
'//                                message
'//                               -Set a 'too many records' error
'//                                message.  too many records will
'//                                cause an overflow when exporting
'//                                to MS Excel
'//
'//////////////////////////////////////////////////////////////////
'// Description:
'//     Function receives an SQL string and outputs the results of
'//     this query to a MS Excel spreadsheet usi9ng ADO recordset
'//     objects.  Andrew Semenov adds the following comments about
'//     about using the ADO objects to export data to MS Excel:
'//
'//     ADVANTAGE: Very fast, reliable and adjustable
'//
'//     DISADVANTAGE: This method is much slowed by the necessity
'//     to transpose matrix received by getrows.  Unfortunately,
'//     getrows puts values in transposed way.  If it can be
'//     avoided some way, speed will increase much.
'//
'//     FEATURES: you have to specify X and y - top left cell, and
'//     in N and M variables you receive the height and width of
'//     range received.  Set Headers variable to true if you need
'//     column headers.
'//
'//     ERRORS: This method is error independent - error values
'//     just ignored.  The components of this solution are ADODB
'//     recordset - used to retrieve records values from query and
'//     put them into array, and ten array is being transposed and
'//     put into MS Excel Range.
'//
'//////////////////////////////////////////////////////////////////
'// Requirements:
'//     Microsoft Visual Basic for Applications
'//     Microsoft Access 9.0 Object Library
'//     Microsoft Excel 9.0 Object Library
'//     Microsoft ActiveX 2.8 Data Objects Library
'//
'//////////////////////////////////////////////////////////////////
'// Input:
'//     Variable   Type    Description
'//     ===========================================================
'//     strSQL     string  sql statement describing record source
'//     lnX        long    top left cell X position in Excel file
'//     lnY        long    top left cell Y position in Excel file
'//     lnN        long    height of range received in Excel file
'//     lnM        long    width of range received in Excel file
'//     blHeaders  boolean yes/no setting for column headers
'//
'//////////////////////////////////////////////////////////////////
On Error GoTo Err_fnExportToExcel_ADO

'Error tracking variable
Dim strCodeBlock As String
Dim strError As String

'Create Excel spreadsheet variables
Dim XL As Object
Dim WB As Workbook
Dim WS As Worksheet

'Export to Excel variables
Dim rst1 As New ADODB.Recordset
Dim rsCon As New ADODB.Connection
    Dim lngRSLoopCount As Long
Dim varA As Variant
Dim varC() As Variant
Dim intJ As Integer
Dim intK As Integer
Dim strConnection As String
Dim varEDW_Credentials As Variant


strCodeBlock = "define recordset and check for results"
Debug.Print Chr(10) & Chr(13) & "strSQL: " & strSQL
    'review EDW login credentials
    varEDW_Credentials = fnReturn_EDW_Credentials()
    
    'if credentials have not been set, then prompt user to set credentials
    If varEDW_Credentials(2) = False Then
        Call fnOpen_Oracle_Credentials_Prompt
        
        'determine whether user elected not to provide EDW login credentials
        varEDW_Credentials = fnReturn_EDW_Credentials
        If varEDW_Credentials(2) = False Then Exit Function
        
    End If
    
    Set rst1 = New ADODB.Recordset

    'open with a pass through query to the EDW
    strConnection = "Driver={Oracle in OraClient11g_home1};"
    strConnection = strConnection & "Dbq=NHEDWP;"
    strConnection = strConnection & "Uid=" & varEDW_Credentials(0) & ";"
    strConnection = strConnection & "Pwd=" & varEDW_Credentials(1) & ";"
    
    rst1.Open strSQL, strConnection, adOpenForwardOnly, adLockOptimistic
    
    lngRSLoopCount = 0
    While rst1.EOF = False
        lngRSLoopCount = lngRSLoopCount + 1
        rst1.MoveNext
    Wend
    
    If lngRSLoopCount = 0 Then
        rst1.Close
        MsgBox "No records detected for export", vbInformation, "Export to MS Excel Failed"
        Exit Function
    ElseIf lngRSLoopCount > 2000 Then
        rst1.Close
        MsgBox lngRSLoopCount & " matching records detected were detected for export.  " & _
            "Please refine your criteria to identify less than 2,000 matching records", _
            vbInformation, _
            "Export to MS Excel Failed"
        Exit Function
    Else
       rst1.MoveFirst
    End If
    
    
strCodeBlock = "Create MS Excel document only if matching records are found"
    'create MS Excel file
        Set XL = CreateObject("excel.application")
    
        'set number of worksheets in workbook
        XL.SheetsInNewWorkbook = 1
        
        'make MS Excel file visible
        XL.Visible = True
        
        'add defined number of worksheet pages to workbook
        Set WB = XL.Workbooks.Add
        
        Set WS = WB.Worksheets(1)
    'End If
    

strCodeBlock = "determine result set size"
    varA = rst1.GetRows()
    ReDim varC(UBound(varA, 2), UBound(varA, 1))
    
strCodeBlock = "populate an array with cell values"
    For intK = 0 To UBound(varA, 1)
        For intJ = 0 To UBound(varA, 2)
            varC(intJ, intK) = varA(intK, intJ)
        Next intJ
    Next intK
    
strCodeBlock = "matrix transposition"
    lnN = UBound(varA, 2) + 1
    lnM = UBound(varA, 1) + 1
    
    WS.Range(WS.Cells(lnY, lnX), WS.Cells(lnN + lnY - 1, lnM + lnX - 1)) = varC
    
strCodeBlock = "column headers inserted if necessary"
    If blHeaders = True Then
        WS.Range(WS.Cells(lnY, lnX), WS.Cells(lnN + lnY - 1, lnM + lnX - 1)).Rows(1).Insert
        For intJ = 0 To lnM - 1
            WS.Cells(lnY, intJ + lnX).Value = rst1.Fields(intJ).Name
        Next intJ
    
    End If
    
    

Exit_fnExportToExcel_ADO:
    rst1.Close
    Set rst1 = Nothing
    Exit Function
    
Err_fnExportToExcel_ADO:
    strError = "Error experienced within " & gstrObject & ": fnExportToExcel_ADO" & Chr(10) & _
        "CodeBlock: " & strCodeBlock & Chr(10) & _
        Err.Number & ": " & Err.Description
        
    Debug.Print strError
    
    MsgBox strError, vbCritical, gstrObject & " " & "Error"
    
    Call fnLogError(gstrObject, "fnExportToExcel_ADO Function", strError)
    
    Resume Next
    
End Function

 

[CJ_London]

Not sure if it is available in Access 2000 but I use copyfromRecordset to populate an Excel spreadsheet

.range("A2").copyfromrecordset P2Rst

P2Rst is the recordset being transferred

Worth a try?

 

[tranchemontaigne]

The problem turned dout to be bad data in the underlying database. Once I figured out that Oracle has a NVL() function that does the same as the MS Access VBA NZ() function I was able to code around the problem.

The object mentioned generating the error code was the recordset. the larger the number of records being fed into the recordset, the better the chance that a record with bad data would be included.

 

[CJ_London]

glad you got it sorted!