Solved

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

Posted on 2002-03-28
8
514 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
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
Salesforce Has Never Been Easier

Improve and reinforce salesforce training & adoption using WalkMe's digital adoption platform. Start saving on costly employee training by creating fast intuitive Walk-Thrus for Salesforce. Claim your Free Account Now

 
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 101

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

Industry Leaders: 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

Introduction While answering a recent question (http://www.experts-exchange.com/Q_27402310.html) in the VB classic zone, I wrote some VB code in the (Office) VBA environment, rather than fire up my older PC.  I didn't post completely correct code o…
When trying to find the cause of a problem in VBA or VB6 it's often valuable to know what procedures were executed prior to the error. You can use the Call Stack for that but it is often inadequate because it may show procedures you aren't intereste…
Get people started with the process of using Access VBA to control Outlook using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Microsoft Outlook. Using automation, an Access applic…
Get people started with the utilization of class modules. Class modules can be a powerful tool in Microsoft Access. They allow you to create self-contained objects that encapsulate functionality. They can easily hide the complexity of a process from…

695 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