Run Time Error 1004 Application-defined or object-defined error - worked in 2003 before 2010 upgrade

[watercooled81]

This is a strange one I hope someone could help with;

The code worked fine, in 2003, the database was open and code was ran in access 2010. Since then the code works fine in 2010 but the following error appears in 2003. "Run-time error '1004': Application-defined or object-defined error.

I have 6 groups of code moving data from an access table to an excel sheet (Please see below)
Each group is almost identical apart from the source table, target file name, and some of the columns.
I have a table of firms where information is taken from and put into the code. There are about 70 firm records.

Now here is the unusual part, the code works fine for 3 or 4 firm records (So all groups of code are run for each firm record). Then the error will appear on one of the groups of code, I dont change anything and just click play, and it carrys on running completing the code it got stuck on and working through another 3 to 6 firm records. It then stops again, on another group of code. click play and it Continues. You can do this until all reports are created.

The highlighted errors in the code also change for example it could be

objWorksheet.Cells(useRow, 1) = rs!A
but on another Public Sub it might be
objWorksheet.Cells(useRow, 3) = rs!C


Has anyone else come across this error? I have Tried Compact and Repair, I created a New DB in 2003 and copied all tables and code, i also created a new one copied tables etc. Then cut and paste the code.

Public Sub ExportingFirms()

'This code brings in the participant Firm information from the qryFirmParticipantsFileNames
'to carry into the UnpaidPremium, Pipeline, Lapses, Canx, Submitted, Issued and Zip Code Below
'The code also carry's the flags/markers showing which reports a firm receives, if they require
'csv formating, and if the reports need to be encrypted.

'This code is for the Firms

Dim db As Database
Dim rs As Recordset

Set db = CurrentDb
Set rs = db.OpenRecordset("qryFirmParticipantsFileNames", dbOpenDynaset)

If rs.EOF = False Then

rs.MoveFirst

While rs.EOF = False

UnpaidPremiumFirm rs!FSANumber, rs!Unpaid, rs!MissedPremiumReport, rs!CSVFileFormats
PipelineReportFirm rs!FSANumber, rs!Pipeline, rs!PipelineReport, rs!CSVFileFormats
LapsesFirm rs!FSANumber, rs!Lapses, rs!LapsesReport, rs!CSVFileFormats
CanxFirm rs!FSANumber, rs!CanxCoolOffs, rs!CanxReport, rs!CSVFileFormats
SubmittedFirm rs!FSANumber, rs!Submitted, rs!SubmittedReport, rs!CSVFileFormats
IssuedFirm rs!FSANumber, rs!Issued, rs!IssuedReport, rs!CSVFileFormats
ZipFilesFirm rs!ZipFile, rs!Encryption

rs.MoveNext

Wend

End If

rs.Close
Set rs = Nothing
db.Close
Set db = Nothing


End Sub

Public Sub UnpaidPremiumFirm(ByVal FSANumber As String, ByVal Unpaid As String, ByVal MissedPremiumReport As Boolean, ByVal CSVFileFormats As Boolean)

'This code creates the Unpaid Premium excel reports in Excel format, the information for the reports comes from
'the sub Exporting Firms. It also saves a CSV File

Dim db As Database
Dim rs As Recordset
Dim objExcel As Excel.Application
Dim objWorkbook As Excel.Workbook
Dim objWorksheet As Excel.Worksheet
Dim sql As String
Dim useRow As Integer
Dim usePanel As String
Dim source As String
Dim target As String

'Checks if the firm has requested the report, and if so the report is produced

If MissedPremiumReport = True Then

Set db = CurrentDb
Set objExcel = New Excel.Application
Set objWorkbook = objExcel.Workbooks.Add("S:\CorporateShared\Sales\NEWBUS99\IntermediaryUnpaidPremiumReports\Intermediary Unpaid Premium Templates\FirmUnpaidPremium.xlt")

Set objWorksheet = objWorkbook.Sheets(1)

sql = "SELECT [qryWeeklyReportUnpaid].* " & _
"FROM [qryWeeklyReportUnpaid] " & _
"WHERE (([qryWeeklyReportUnpaid].P)=" & FSANumber & ")"



Set rs = db.OpenRecordset(sql, dbOpenDynaset)

If rs.EOF = False Then

rs.MoveFirst

useRow = 2

While rs.EOF = False

objWorksheet.Cells(useRow, 1) = rs!A
objWorksheet.Cells(useRow, 2) = rs!B
objWorksheet.Cells(useRow, 3) = rs!C
objWorksheet.Cells(useRow, 4) = rs!D
objWorksheet.Cells(useRow, 5) = rs!E
objWorksheet.Cells(useRow, 6) = rs!F
objWorksheet.Cells(useRow, 7) = rs!G
objWorksheet.Cells(useRow, 8) = rs!H
objWorksheet.Cells(useRow, 9) = rs!I
objWorksheet.Cells(useRow, 10) = rs!J
objWorksheet.Cells(useRow, 11) = rs!K
objWorksheet.Cells(useRow, 12) = rs!L
objWorksheet.Cells(useRow, 13) = rs!M
objWorksheet.Cells(useRow, 14) = rs!N
objWorksheet.Cells(useRow, 15) = rs!O
objWorksheet.Cells(useRow, 16) = rs!S

useRow = useRow + 1
rs.MoveNext

Wend

End If

objWorksheet.Name = "Unpaid Premiums"

Set objWorksheet = objWorkbook.Sheets(1)

objWorkbook.SaveAs "S:\CorporateShared\Sales\NEWBUS99\IntermediaryUnpaidPremiumReports\FirmFiles\" & Unpaid & ".xls", FileFormat:=56

'Checks if CSV format is required and if so a CSV version of the report is saved.

If CSVFileFormats = True Then

objWorkbook.SaveAs "S:\CorporateShared\Sales\NEWBUS99\IntermediaryUnpaidPremiumReports\FirmFiles\" & Unpaid & ".csv", 23

End If


objWorkbook.Close True


Set objWorksheet = Nothing
Set objWorkbook = Nothing
Set objExcel = Nothing
Set rs = Nothing
Set db = Nothing

Else
GoTo Exit_UnpaidPemium


End If

Exit_UnpaidPemium:
Exit Sub


End Sub

 

[watercooled81]

Hi All.

Not the best of solutions, but used the Error handler code to rerun the code. Not the correct way to use it I know, but as the script had originally been running for a number of years without issue. The risk is low;
Dim Errorsfound As Integer





On Error GoTo Errorfound
'Due to the database being run in access 2010 there are some errors that appear when run in access 2003
'Run-time error '1004': Application-defined or object-defined error. This error does not impact the code,
'and means the user has to keep Executing the code after the error.
'The code below, ignores the first error and carries on. If there is more then one error a message will appear
'and the code is stopped.



Errorsfound = 0

If rs.EOF = False Then

rs.MoveFirst

useRow = 2

While rs.EOF = False

Errorfound:

If rs![A] = CurrentRecord Then

Errorsfound = Errorsfound + 1

If Errorsfound > 1 Then

MsgBox Err.Description
End

End If

Else

CurrentRecord = rs![A]

End If

Then I continue my code..

 

[genomon]

Try DIMing the database and recordset objects explixiyly as DAO.Database and DAO.Recordset.

Beir bua agus beannacht!

 

[watercooled81]

Hi Genomon,

My code has not worked out, so tried DAO-ing but still the same issue. I cant understand why it works perfectly fine in 2010
but in 2003, it has issues, but as soon as you excute the code again it works..

 

[Andrzejek]

Did you try:

Set rs = db.OpenRecordset(sql, dbOpenDynaset)
Sheet(1).Range("A2").[blue]CopyFromRecordset rs[/blue]
...

instead of looping thru your rs?

Have fun.

---- Andy

A bus station is where a bus stops. A train station is where a train stops. On my desk, I have a work station.

 

[watercooled81]

Interestingly - I am getting the same problem but a different error message appears now.
Again, click debug then execute and the code carrys on fine.

Run-time error'-2147417859 (80010100)':
Method 'CopyFromRecordset' of object 'Range' failed

 

[jsteph]

Have you tried using dbOpenSnapshot instead of dbOpenDynaset for the OpenRecordset method?
--Jim