Solved

Export from VB to Excel - Run-time error '1004': Application-defined or object-defined error

Posted on 2002-03-28
8
511 Views
Last Modified: 2007-12-19
I have the following code.  It gives me "Run-time error '1004': Application-defined or object-defined error"
Search for '****' for the line with the error.  I need to make this thing work.  I need code to help fix this.
Any help greatly appreciated.

Chess
------------------------------------------------------
Private Sub ExportData()

    On Error GoTo errHandle
   
    Dim sSql As String
    Dim rs As New ADODB.Recordset
    Dim sTradeId As String, iFundNumber As Long
    Dim intCount As Integer
    Dim sExportLogFileName As String
    Dim fileNum As Long
    Dim xlApp As Object
    Set xlApp = CreateObject("Excel.Application")
   
    sExportLogFileName = App.Path & "\" & cmbFundNumber.Text & ".xls"
    fileNum = FreeFile
   
    If Dir(sExportLogFileName) <> "" Then
        Kill sExportLogFileName
    End If
   
    intCount = 1

    sSql = "Select RTE_TRADE_ID, FUND_NUM from ATI_RTE_TRADES WHERE FUND_NUM = " & cmbFundNumber.Text
    sSql = sSql & " AND POST_DATE is null"
    rs.Open sSql, gDBOracle, adOpenStatic
   
    ' Set header values for sheet 1.
    With xlApp.Worksheets("Sheet1").Rows(intCount) '**** Error on this line****
        .Font.Bold = True
        .Cells(1, 5).Value = "Trade Id"
        .Cells(1, 6).Value = "Fund Number"
    End With
   
    While Not rs.EOF
        sTradeId = rs.Fields("RTE_TRADE_ID")
        iFundNumber = rs.Fields("FUND_NUM")
        intCount = intCount + 1
        Call AddToSheet(intCount, sTradeId, iFundNumber)
        rs.MoveNext
    Wend
   
    xlApp.ActiveWorkbook.Worksheets(1).SaveAs sExportLogFileName
    xlApp.ActiveWorkbook.Close
 
    xlApp.Quit
 
    Set xlApp = Nothing


    Exit Sub
   
errHandle:
    MsgBox "Error " & Err.Number & " in Sub ExportData.  The error is - " & Err.Description, vbOKOnly + vbCritical, APPNAME

End Sub

Public Function AddToSheet(intCount As Integer, sTradeId As String, iFundNumber As Long)

' This function adds recordset data to sheet one row at a time.
' Values are passed from GetData procedure.
   
    With xlApp.ActiveWorkbook.Worksheets("Sheet1").Rows(intCount)
        .Cells(10, 5).Value = sTradeId
        .Cells(10, 6).Value = iFundNumber
    End With
   
End Function
0
Comment
Question by:Chess
8 Comments
 
LVL 44

Expert Comment

by:bruintje
ID: 6902640
Hi Chess, does Sheet1 exist, better use Sheets(1)

:O)Bruintje
0
 
LVL 1

Author Comment

by:Chess
ID: 6902670
I tried your suggestion. Did not work.  Am I doing something wrong?  Would help if you could post your code.
Chess
0
 
LVL 1

Author Comment

by:Chess
ID: 6902690
FYI
I am using ADO 2.1 and Excel 97
I know that this is a known issue http://support.microsoft.com/default.aspx?scid=kb;en-us;Q246335

My hands are tied.  I am required to use ADO and Excel 97 only.
0
Courses: Start Training Online With Pros, Today

Brush up on the basics or master the advanced techniques required to earn essential industry certifications, with Courses. Enroll in a course and start learning today. Training topics range from Android App Dev to the Xen Virtualization Platform.

 
LVL 18

Expert Comment

by:bobbit31
ID: 6902698
try this instead:

   With xlApp.Worksheets("Sheet1").Cells(intCount) '**** if you leave second param blank, selects whole row****
       .Font.Bold = True
       .Cells(1, 5).Value = "Trade Id"
       .Cells(1, 6).Value = "Fund Number"
   End With
   
alternatively, use ranges:

Dim xl As New Excel.Application
Dim wksht As Excel.Worksheet
Dim range As Excel.range

Set wksht = xl.Worksheets(1)
Set range = wksht.Cells(1)

With range
    .Font.Bold = True
    .Cells(1, 5).Value = "Trade Id"
    .Cells(1, 6).Value = "Fund Number"
End With
0
 
LVL 100

Expert Comment

by:mlmcc
ID: 6902737
Here's code I use to export data to a spreadsheet


Public Sub Create_Rpt_Spreadsheet(VIEW_NAME As String, _
                                   Where_Clause As String)

Dim rs_Data As ADODB.Recordset
Dim str_Select As String

Dim rs_Cols As ADODB.Recordset
Dim str_Cols As String

Dim objExcel As Excel.Application

Dim numRows As Integer
Dim numCols As Integer

Dim row As Integer
Dim col As Integer

On Error GoTo Err_SS_Recordset

    Screen.MousePointer = vbHourglass

'
'   Create recordset
'
    str_Select = "SELECT  *  FROM  " & VIEW_NAME
    If (Where_Clause <> "") Then
        str_Select = str_Select & "  WHERE  " & Where_Clause
    End If
   
    Set rs_Data = New ADODB.Recordset
    rs_Data.CursorLocation = adUseClient
    rs_Data.Open str_Select, cn, adOpenStatic, adLockReadOnly
    If (rs_Data.RecordCount <= 0) Then
        MsgBox "No data to export to Excel for your filter.", vbOKOnly, "No Data"
        rs_Data.Close
        Set rs_Data = Nothing
        Exit Sub
    End If
   
On Error GoTo Err_Create_Rpt_Spreadsheet

'
'   Initialize number of rows and columns
'
    numCols = rs_Data.Fields.count
    numRows = rs_Data.RecordCount
   
'
'   Create Excel Spreadsheet
'
    Set objExcel = New Excel.Application
    objExcel.Workbooks.Add

'
'   Set defaults for the spreadsheet
'
    objExcel.Cells.Select
    With objExcel.Selection.Font
        .Name = "Arial"
        .FontStyle = "Regular"
        .Size = 9
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With

'
'   Open form showing export progress
'
    'frm_Export2Excel.Show
    frm_Export2Excel.lbl_Exp2Excel.Caption = "Header Row  "
   
'
'   Load column headers
'
    str_Cols = "SELECT  *  FROM  view_Excel_Col_Info where txt_ViewName = '" & VIEW_NAME & "'"
    Set rs_Cols = New ADODB.Recordset
    rs_Cols.Open str_Cols, cn, adOpenStatic, adLockReadOnly
    row = 1

'
'   Use the information from the Excel Column Information table if it exists.
'   Use the view field name otherwise
'
    If (rs_Cols.RecordCount > 0) Then
        For col = 1 To numCols
            rs_Cols.MoveFirst
            rs_Cols.Find "txt_FieldName = '" & rs_Data.Fields(col - 1).Name & "'"
            objExcel.Cells(row, col) = Trim(rs_Cols!txt_ColName)
            objExcel.Range(objExcel.Cells(row, col), objExcel.Cells(row, col)).Select
            objExcel.Selection.ColumnWidth = rs_Cols!int_ColWidth
            If (InStr(rs_Cols!txt_ColName, "Date")) Then
                objExcel.Range(objExcel.Cells(row + 1, col), objExcel.Cells(row + rs_Data.RecordCount, col)).Select
                objExcel.Selection.NumberFormat = "dd-mmm-yyyy"
            End If
        Next col
    Else
        For col = 1 To numCols
            objExcel.Cells(row, col) = Trim(rs_Data.Fields(col - 1).Name)
            objExcel.Range(objExcel.Cells(row, col), objExcel.Cells(row, col)).Select
            objExcel.Selection.ColumnWidth = 8
        Next col
    End If
    frm_Export2Excel.pb_Exp2Excel.Value = 100# * row / (numRows + 1)
'
'   Close the column information recordset
'
    rs_Cols.Close
    Set rs_Cols = Nothing

'
'   Load selected records into rows
'

    rs_Data.MoveFirst
    For row = 2 To numRows + 1
        frm_Export2Excel.lbl_Exp2Excel.Caption = "Row " & str(row - 1) & " of  " & str(numRows)
        frm_Export2Excel.pb_Exp2Excel.Value = 100# * row / (numRows + 1)
        For col = 1 To numCols
            objExcel.Cells(row, col) = rs_Data.Fields(col - 1).Value
        Next col
        objExcel.Rows(row).Select
        objExcel.Selection.RowHeight = 15
        rs_Data.MoveNext
    Next row

'
'   Activate the Excel spreadsheet
'
    Unload frm_Export2Excel
   
    objExcel.Range("A1").Select
    objExcel.Visible = True
    Screen.MousePointer = vbDefault

Exit_btnCancel_Click:
    rs_Data.Close
    Set rs_Data = Nothing
    Set objExcel = Nothing
    Exit Sub
   
Err_SS_Recordset:
    MsgBox Err.Description
    Set rs_Data = Nothing
    Screen.MousePointer = vbDefault
    Unload frm_Export2Excel
    Exit Sub

Err_Create_Rpt_Spreadsheet:
    MsgBox Err.Description
    objExcel.Visible = True
    Unload frm_Export2Excel
    Resume Exit_btnCancel_Click

End Sub

mlmcc
0
 
LVL 44

Accepted Solution

by:
bruintje earned 150 total points
ID: 6902755
or add the workbook

   xlApp.Workbooks.Add
   With xlApp.Workbooks(1).Worksheets(1)   '**** Error on this line****
       With .Cells(1, 5)
         .Value = "Trade Id"
         .Font.Bold = True
       End With
       With .Cells(1, 6)
         .Value = "Fund Number"
         .Font.Bold = True
       End With
   End With
0
 
LVL 1

Author Comment

by:Chess
ID: 6902777
bruintje,
Thanks!  It was like looking for a needle in a haystack.
Many thanks to all others for their contribution.
Chess
0
 
LVL 44

Expert Comment

by:bruintje
ID: 6902795
didn't have the possibillity to test until i came home ;)
0

Featured Post

Gigs: Get Your Project Delivered by an Expert

Select from freelancers specializing in everything from database administration to programming, who have proven themselves as experts in their field. Hire the best, collaborate easily, pay securely and get projects done right.

Question has a verified solution.

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

The debugging module of the VB 6 IDE can be accessed by way of the Debug menu item. That menu item can normally be found in the IDE's main menu line as shown in this picture.   There is also a companion Debug Toolbar that looks like the followin…
Enums (shorthand for ‘enumerations’) are not often used by programmers but they can be quite valuable when they are.  What are they? An Enum is just a type of variable like a string or an Integer, but in this case one that you create that contains…
As developers, we are not limited to the functions provided by the VBA language. In addition, we can call the functions that are part of the Windows operating system. These functions are part of the Windows API (Application Programming Interface). U…
Show developers how to use a criteria form to limit the data that appears on an Access report. It is a common requirement that users can specify the criteria for a report at runtime. The easiest way to accomplish this is using a criteria form that a…

776 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