Hi,

When automating my VB6 app with Excel it works the first time but when I run
it a second time it comes up with the above error. Below is my code,
appreciate any help on this.

Public Sub rep_pending_assess_excel()
On Error GoTo Err_rep_pending_assess_excel

'This compiles a spreadsheet showing where pending assessment has been
ticked
Dim cmd As ADODB.Command
Dim rst As ADODB.Recordset
Dim Excel As Excel.Application
Dim workbook As Excel.workbook
Dim wrk As frm_working

Set cmd = New ADODB.Command
Set rst = New ADODB.Recordset
Set Excel = CreateObject("Excel.application")
Set workbook = Excel.Workbooks.Add
Set wrk = New frm_working

If con_open = False Then
msg_con_failed
Else

wrk.Show , frm_menu
wrk.Caption = "Exporting Database......."
wrk.ProgressBar.Value = 10

With rst
.CursorType = adOpenStatic
.CursorLocation = adUseClient
.LockType = adLockBatchOptimistic
End With

wrk.ProgressBar.Value = 20

With cmd
Set .ActiveConnection = cn
.CommandType = adCmdStoredProc
.CommandText = "proc_rep_pending_assess_excel"
End With


With rst
.Open cmd
If .RecordCount 0 Then
Excel.Visible = True
workbook.ActiveSheet.Range("A3").Value = "ID"
workbook.ActiveSheet.Columns("A").ColumnWidth = 5
wrk.ProgressBar.Value = 30
workbook.ActiveSheet.Range("B3").Value = "Forename"
workbook.ActiveSheet.Columns("B").ColumnWidth = 17
workbook.ActiveSheet.Range("C3").Value = "Surname"
wrk.ProgressBar.Value = 40
workbook.ActiveSheet.Columns("C").ColumnWidth = 17
workbook.ActiveSheet.Range("D3").Value = "Address 1"
workbook.ActiveSheet.Columns("D").ColumnWidth = 12
wrk.ProgressBar.Value = 50
workbook.ActiveSheet.Range("E3").Value = "Address 2"
workbook.ActiveSheet.Columns("E").ColumnWidth = 12
workbook.ActiveSheet.Range("A3:E3").Select
Selection.Font.Bold = True
workbook.ActiveSheet.Range("A1").Value = "Pending Assessment"
workbook.ActiveSheet.Range("A1").Select
Selection.Font.Bold = True
workbook.ActiveSheet.Range("A1").Select
Selection.Font.Size = "14"
wrk.ProgressBar.Value = 100
workbook.ActiveSheet.Range("A4").CopyFromRecordset rst
End If
.Close
End With
wrk.Caption = "Done"
End If

Exit_rep_pending_assess_excel:
Set cmd = Nothing
Set rst = Nothing
Set Excel = Nothing
Set workbook = Nothing
Unload wrk
Set wrk = Nothing
con_close
Exit Sub
Err_rep_pending_assess_excel:
MsgBox Err.Number & " " & Err.Description
Resume Exit_rep_pending_assess_excel
End Sub



Thanks

Damon