Link to home
Start Free TrialLog in
Avatar of gdunn59
gdunn59

asked on

Error 1004: Application-defined or object-defined error

When I run my code, I'm getting the following errors:

 Error: 1004
 ExportToExcel
 Application-defined or object-defined error

 Then if I click on OK, it continues through the code, but  then I get this error:

 Error: 1004
 CombineAndExport
 Application-defined or object-defined error

 Then if I click on OK, the process finishes, and the populated spreadsheet is open and the error is on the screen.  This is after the data has already exported to the spreadsheet.

 Here is the code for the Functions ExportToExcel (which is the Code I initially posted) and CombineAndExport
Function ExportToExcel(bSkipFF As Boolean, Optional bIsALL As Boolean = False) As Long
On Error GoTo ErrHandler
  Dim strFilePath As String
  Dim xlApp As Excel.Application
  Dim xlWorkBook As Excel.Workbook
  Dim xlsheet As Excel.Worksheet
  
   
  strFilePath = GetWinTempPath & "FracFocusData.xlsx"
  If Dir(strFilePath) <> "" Then Kill strFilePath
  
  If bIsALL = True Then
    DoCmd.TransferSpreadsheet acExport, , "qry_FRAC_ACTIVITY_ALL", strFilePath
  Else
    DoCmd.TransferSpreadsheet acExport, , "qry_FRAC_ACTIVITY_SEL", strFilePath
    DoCmd.TransferSpreadsheet acExport, , "qry_JL_03", strFilePath
  End If
  
  Set xlApp = New Excel.Application
  Set xlWorkBook = xlApp.Workbooks.Open(strFilePath)
  xlApp.Visible = True
 
  If bIsALL = True Then
    xlApp.Worksheets("qry_FRAC_ACTIVITY_ALL").Name = "FracData"
  Else
    xlApp.Worksheets("qry_FRAC_ACTIVITY_SEL").Name = "FracData"
    xlApp.Worksheets("qry_JL_03").Name = "OnlyOnLeviRpt"
  End If
  
  xlApp.Worksheets(1).select
  ExportToExcel = MakeExcelPretty(xlApp, bSkipFF, bIsALL)
  If ExportToExcel <> 0 Then
    Set xlsheet = Nothing
    Set xlWorkBook = Nothing
    Set xlApp = Nothing
    Exit Function
  End If
  
  If WksExists("OnlyOnLeviRpt") Then
  
' xlApp.Worksheets("OnlyOnLeviRpt").select
    ExportToExcel = MakeExcelPretty(xlApp, bSkipFF, bIsALL)
  If ExportToExcel <> 0 Then
    Set xlsheet = Nothing
    Set xlWorkBook = Nothing
    Set xlApp = Nothing
    Exit Function
  End If
  
  Else
  xlApp.Worksheets(1).select
  End If
    
ErrHandler:
  Set xlsheet = Nothing
  Set xlWorkBook = Nothing
  Set xlApp = Nothing

  If err.Number = 70 Then 'user probably has it open
    MsgBox "Please Close FracFocusData.xls", vbExclamation, "Unable to Export"
    ExportToExcel = -1
    Exit Function
  End If

  ExportToExcel = ErrorHandler(err, "ExportToExcel")
End Function



Function ExportToExcel(bSkipFF As Boolean, Optional bIsALL As Boolean = False) As Long
On Error GoTo ErrHandler
  Dim strFilePath As String
  Dim xlApp As Excel.Application
  Dim xlWorkBook As Excel.Workbook
  Dim xlsheet As Excel.Worksheet
  
   
  strFilePath = GetWinTempPath & "FracFocusData.xlsx"
  If Dir(strFilePath) <> "" Then Kill strFilePath
  
  If bIsALL = True Then
    DoCmd.TransferSpreadsheet acExport, , "qry_FRAC_ACTIVITY_ALL", strFilePath
  Else
    DoCmd.TransferSpreadsheet acExport, , "qry_FRAC_ACTIVITY_SEL", strFilePath
    DoCmd.TransferSpreadsheet acExport, , "qry_JL_03", strFilePath
  End If
  
  Set xlApp = New Excel.Application
  Set xlWorkBook = xlApp.Workbooks.Open(strFilePath)
  xlApp.Visible = True
 
  If bIsALL = True Then
    xlApp.Worksheets("qry_FRAC_ACTIVITY_ALL").Name = "FracData"
  Else
    xlApp.Worksheets("qry_FRAC_ACTIVITY_SEL").Name = "FracData"
    xlApp.Worksheets("qry_JL_03").Name = "OnlyOnLeviRpt"
  End If
  
  xlApp.Worksheets(1).select
  ExportToExcel = MakeExcelPretty(xlApp, bSkipFF, bIsALL)
  If ExportToExcel <> 0 Then
    Set xlsheet = Nothing
    Set xlWorkBook = Nothing
    Set xlApp = Nothing
    Exit Function
  End If
  
  If WksExists("OnlyOnLeviRpt") Then
  
' xlApp.Worksheets("OnlyOnLeviRpt").select
    ExportToExcel = MakeExcelPretty(xlApp, bSkipFF, bIsALL)
  If ExportToExcel <> 0 Then
    Set xlsheet = Nothing
    Set xlWorkBook = Nothing
    Set xlApp = Nothing
    Exit Function
  End If
  
  Else
  xlApp.Worksheets(1).select
  End If
    
ErrHandler:
  Set xlsheet = Nothing
  Set xlWorkBook = Nothing
  Set xlApp = Nothing

  If err.Number = 70 Then 'user probably has it open
    MsgBox "Please Close FracFocusData.xls", vbExclamation, "Unable to Export"
    ExportToExcel = -1
    Exit Function
  End If

  ExportToExcel = ErrorHandler(err, "ExportToExcel")
End Function

Open in new window

ASKER CERTIFIED SOLUTION
Avatar of Martin Liss
Martin Liss
Flag of United States of America image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of gdunn59
gdunn59

ASKER

Martin Liss,

That fixed the issue with the Error 1004, but there is a Function Function CombineAndExport(bSkipFF As Boolean, Optional bIsALL As Boolean = False) As Long.  See code below for this function , and now Line 38 of the ExportToExcel Function that I posted doesn't process, it doesn't recognize the Sheet "OnlyOnLeviRpt", it shows as False.

There are 2 buttons on the Form that are driven by the same Function ExportToExcel.  One button is "Combine and Export" and when the button is clicked, it calls the Function CombineAndExport (see code below). On Line 12 of this Function, it goes to the Function ExportToExcel, which is the same Function that is used by the other button "ExportAll".  

The code processes fine and does the formatting if the report only contains the one Sheet "FracData" (which is for the "Export All" button).  But if the report contains 2 Sheets "FracData" and "OnlyOnLeviRpt" which is for the "Combined And Export" button, then it formats the first sheet "FracData" only, but doesn't format the 2nd sheet "OnlyOnLeviRpt".   When it gets to Line 38 of the Code for the Function ExportToExcel, it goes to the "Function WksExists(wksName as String) as Boolean" and checks if the Sheet "OnlyOnLeviRpt" exists (see the code for this function below).  Most of the time Line 3 of the Code in the "Function Function WksExists" equates to False.  A couple of times it was True.  I don't understand why it would do this, when all I'm doing is clicking on the "Combined And Export" button each time.

Function CombineAndExport(bSkipFF As Boolean, Optional bIsALL As Boolean = False) As Long
  On Error GoTo ErrHandler
  
  DoCmd.SetWarnings False
  'we have to modify the api number from the website since it is not formatted the same as our system
  If bSkipFF = False Then
    DoCmd.RunSQL "UPDATE FRAC_FOCUS_DATA SET FRAC_FOCUS_DATA.API_MOD = Replace([API],'-','');"
    DoCmd.RunSQL "UPDATE FRAC_FOCUS_DATA SET FRAC_FOCUS_DATA.API_MOD = Left([API_MOD],10);"
    DoCmd.RunSQL "UPDATE FRAC_ACTIVITY_SEL INNER JOIN FRAC_FOCUS_DATA ON FRAC_ACTIVITY_SEL.API_NO = FRAC_FOCUS_DATA.API_MOD SET FRAC_ACTIVITY_SEL.IN_FRAC_FOCUS = 1;"
  End If
     
  CombineAndExport = ExportToExcel(bSkipFF, bIsALL)
  If CombineAndExport <> 0 Then Exit Function

Exit Function

ErrHandler:
  DoCmd.SetWarnings True
  CombineAndExport = ErrorHandler(err, "CombineAndExport")
End Function

Open in new window


Here again is the Code for Function ExportToExcel:
Function ExportToExcel(bSkipFF As Boolean, Optional bIsALL As Boolean = False) As Long
  On Error GoTo ErrHandler
  Dim strFilePath As String
  Dim xlApp As Excel.Application
  Dim xlWorkBook As Excel.Workbook
  Dim xlsheet As Excel.Worksheet
   
  strFilePath = GetWinTempPath & "FracFocusData.xlsx"
  If Dir(strFilePath) <> "" Then Kill strFilePath
  
  If bIsALL = True Then
    DoCmd.TransferSpreadsheet acExport, , "qry_FRAC_ACTIVITY_ALL", strFilePath
  Else
    DoCmd.TransferSpreadsheet acExport, , "qry_FRAC_ACTIVITY_SEL", strFilePath
    DoCmd.TransferSpreadsheet acExport, , "qry_JL_03", strFilePath
  End If
  
  Set xlApp = New Excel.Application
  Set xlWorkBook = xlApp.Workbooks.Open(strFilePath)
  xlApp.Visible = True
 
  If bIsALL = True Then
    xlApp.Worksheets("qry_FRAC_ACTIVITY_ALL").Name = "FracData"
  Else
    xlApp.Worksheets("qry_FRAC_ACTIVITY_SEL").Name = "FracData"
    xlApp.Worksheets("qry_JL_03").Name = "OnlyOnLeviRpt"
  End If
  
  xlApp.Worksheets(1).select
  ExportToExcel = MakeExcelPretty(xlApp, bSkipFF, bIsALL)
  If ExportToExcel <> 0 Then
    Set xlsheet = Nothing
    Set xlWorkBook = Nothing
    Set xlApp = Nothing
    Exit Function
  End If
  
  If WksExists("OnlyOnLeviRpt") Then
    xlApp.Worksheets("OnlyOnLeviRpt").select
    ExportToExcel = MakeExcelPretty(xlApp, bSkipFF, bIsALL)
  If ExportToExcel <> 0 Then
    Set xlsheet = Nothing
    Set xlWorkBook = Nothing
    Set xlApp = Nothing
    Exit Function
  End If

  Else
  xlApp.Worksheets(1).select
  End If
    
Exit Function

ErrHandler:
  Set xlsheet = Nothing
  Set xlWorkBook = Nothing
  Set xlApp = Nothing

  If err.Number = 70 Then 'user probably has it open
    MsgBox "Please Close FracFocusData.xls", vbExclamation, "Unable to Export"
    ExportToExcel = -1
    Exit Function
  End If

  ExportToExcel = ErrorHandler(err, "ExportToExcel")
  
End Function

Open in new window


Function WksExists(wksName As String) As Boolean
    On Error Resume Next
    WksExists = CBool(Len(Worksheets(wksName).Name) > 0)
End Function

Open in new window


Thanks,
gdunn59
Can you supply a sample workbook?
Avatar of gdunn59

ASKER

Attached is a sample workbook (I removed the actual private data).

Thanks,
gdunn59
C--Users-msc551-Desktop-Data.xlsx
You attached an xlsx workbook which can not contains code so I need an xlm version that includes the code.
Avatar of gdunn59

ASKER

Ok
Avatar of gdunn59

ASKER

The Functions that it is using, I've posted.

Can you just get it from there?  Will that be sufficient?

Thanks,
gdunn59
Avatar of gdunn59

ASKER

Martin Liss,

It's the last 3 Functions that I posted.

Thanks,
gdunn59
Avatar of gdunn59

ASKER

Martin Liss,

The VBA Code is not saved in the spreadsheet, it is in a MS Access Database.

Thanks,
gdunn59
I'm sorry but I don't do Access.