automation error

Excel again!

I do the following:

Code:

---

Private Sub cmdSendTCompToExcel_Click()
On Error GoTo Err_Handler

Dim objXL As Excel.Application
Dim objXLWrkBk As Excel.Workbook
Dim objXLWrkSht As Excel.Worksheet

'was the calc sheet ever created?
If Me.chkCalcCreated.Value = 0 Then
    'nope...someone has to create before we can send the data
    'over to the sheet
    MsgBox "The calculation sheet for this proposal was never created." & _
          Chr(13) & "Please make sure you have created the calculation sheet" & _
          Chr(13) & "before sending data to the calculation sheet.", vbInformation, "Create Calc. Sheet"
    Me.cmdExcel.SetFocus
    Exit Sub
End If

'was the transport ever created
If Me.txtTransportID.Text = "" Then
    MsgBox "You must create a transport before sending data to the calc. sheet.", vbInformation, "Create Transport First"
    Exit Sub
End If

Set objXL = CreateObject("Excel.Application")
Set objXLWrkBk = objXL.Workbooks.Open(Me.txtCalcSheetLink.Text)

'is the calculation sheet opened?
If objXLWrkBk.ReadOnly Then
    MsgBox "Please close the calculation sheet before sending any data!", vbExclamation, "Close Calculation Sheet!"
    Exit Sub
End If

'turn on the hourglass
'cause this could take some time...
Screen.MousePointer = vbHourglass

objXL.DisplayAlerts = False                      'don't show any alerts
objXL.Visible = False                            'hide the sheet

objXL.Application.ScreenUpdating = True          'allow updates

    If (WorkSheetExists(Me.txtTPos.Text, objXL)) Then
        'do nothing
        'sheet exists already so we just need to add the components
    Else
        'create the sheet
        Call CreateWorkSheet(Me.txtTPos.Text, objXL)
        objXLWrkBk.Save
    End If

Call InsertComponents(Me.txtTPos.Text, objXL)    'now insert the components

objXLWrkBk.Close SaveChanges:=True              'save the changes
objXL.Quit                                      'quit excel

Done:
Screen.MousePointer = vbDefault
Set objXLWrkSht = Nothing
Set objXLWrkBk = Nothing
Set objXL = Nothing
Exit Sub

Err_Handler:
MsgBox Err.Description, vbCritical, "Error #: " & Err.Number
Resume Done

End Sub

---

But right when I get to the line where I do the saving:

Code:

---

objXLWrkBk.Close SaveChanges:=True              'save the changes

---

It flags an error...and says:
Automation error: The object has disconnected itself from the clients.

Im like Whattttttttttttt???????? :)
I dont see where this object has disconnected itself...I do however pass that object to another method by reference..but I do NOT close that object or set it to notihng.

in fact Ill post that other method:

Code:

---

Function InsertComponents(Pos As String, ByRef objXL As Excel.Application)
On Error GoTo Err_Handler

Dim rst As ADODB.Recordset
Dim objCmd As ADODB.Command

Dim strComponentT As String    'component in Kalk Sheet DB T in the form TXXX
Dim strComponentTID As String  'component end in DB T in the form XXX
                                'basically this variable identifies the component in DB T

Dim objXLDBTWkBk As Excel.Workbook
Dim objXLEuroWkbk As Excel.Workbook

Dim objXLEuroWrkSht As Excel.Worksheet
Dim objXLDBTWrkSht As Excel.Worksheet

Dim Zeilennummer As Long
Dim Zelle As Variant

Call EstablishConnection
Set objCmd = New ADODB.Command
 
 'the following stored procedure will
 'return all transport components that have
 'not been sent to excel and belong to the current
 'transport TransportID
    With objCmd
        .ActiveConnection = objConn
        .CommandText = "select_transport_components_to_calc_sheet"
        .CommandType = adCmdStoredProc        'its a stored procedure
        .Parameters.Append .CreateParameter("TransportID", adBigInt, adParamInput, , Me.txtTransportID.Text)
        Set rst = .Execute
    End With

    If rst.BOF Then
        'no records
        MsgBox "No components have been created for this transport." & Chr(13) & _
              "No data will be sent to the calc. sheet.", vbInformation, "No Components"
        Exit Function
    Else
        objXL.Application.ScreenUpdating = True
        Set objXLDBTWkBk = objXL.Workbooks.Open(DatabaseTPath, ReadOnly:=True)    'opens db t
        Set objXLEuroWkbk = objXL.Workbooks.Open(Me.txtCalcSheetLink.Text)    'euro kalk workbook

        Set objXLDBTWrkSht = objXLDBTWkBk.Worksheets("Tabelle1") 'dbt sheet
        Set objXLEuroWrkSht = objXLEuroWkbk.Worksheets(Pos)                                'euro kalk sheet POS

        While Not rst.EOF
            Me.lblkleur.Width = 10 / rst.RecordCount * (rst.AbsolutePosition + 1) * 570
            Me.percent.Caption = Format(10 / rst.RecordCount * (rst.AbsolutePosition + 1) * 10, "##") & " %"
            Me.lblFunction.Caption = "Creating transport components in calculation sheet..."
               
            objXLEuroWkbk.Activate
            objXLEuroWrkSht.Activate
            objXLEuroWrkSht.Range("C6").Activate
            objXLEuroWrkSht.Columns("C").Find("", objXL.ActiveCell, , , xlByRows, xlNext).Activate
            'grab the component ID TXXX
       
            'strComponentT = Nz(DLookup("[TDataString]", "tblDatabaseT", "TID= " & Nz(rs("TID").Value, 0)))
            'ABOVE WE MUST REPLACE WITH TXXX
            strComponentT = "T004"
            'find it
            objXLDBTWkBk.Activate
            objXLDBTWrkSht.Range("A1").Activate  'go to the top of the sheet
            objXLDBTWrkSht.Cells.Find(What:=strComponentT, After:=objXL.ActiveCell, LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False).Activate
            objXL.ActiveCell.Range("A1:AB1").Select
               
            'copy selection
            objXL.Selection.Copy
   
            objXLEuroWkbk.Activate
            objXLEuroWrkSht.Activate
       
            Zeilennummer = (objXL.ActiveCell.Row)
            Zelle = ("C" & Zeilennummer)
            objXL.Range(Zelle).Activate
       
            'this line does copying
            objXL.Selection.PasteSpecial Paste:=xlFormulas, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
       
            'make this part DB T activated
            objXLDBTWkBk.Activate
       
            ' Added 3 April 2001
            objXL.ActiveCell.Range("AH1").Select
            objXL.Selection.Copy
       
            'Make this part EuroKalk Sheet Activated
            objXLEuroWkbk.Activate
            objXLEuroWrkSht.Activate
 
            objXL.ActiveCell.Range("B1").Select
       
            objXL.Selection.PasteSpecial Paste:=xlFormulas, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
       
            objXLEuroWkbk.Activate
            objXLEuroWrkSht.Activate
       
            objXL.Cells(Zeilennummer, "A").Value = rst("TCPos").Value
            objXL.Cells(Zeilennummer, "G").Value = rst("N").Value
            objXL.Cells(Zeilennummer, "H").Value = rst("Quantity").Value
            objXL.ActiveCell.Offset(0, 4).Activate
            objXL.ActiveCell.FormulaR1C1 = rst("Quantity").Value
       
            objXL.Application.ScreenUpdating = True

            'Application.Run ("zellposition")
            Zeilennummer = (objXL.ActiveCell.Row)
            Zelle = ("C" & Zeilennummer)
            objXL.Range(Zelle).Activate

            objXL.ActiveCell.Offset(1, -2).Activate
            objXL.Application.Calculation = xlCalculationAutomatic
       
            With objXL.ActiveWindow
                .WindowState = xlMaximized
            End With
           
            rst.MoveNext
            DoEvents
        Wend
   
    Set objCmd = Nothing
    Set objCmd = New ADODB.Command
 
 'the following stored procedure will
 'now update all the transport components
 'as being sent to excel.
 'transport TransportID
   
    With objCmd
        .ActiveConnection = objConn
        .CommandText = "update_transport_components_excel_field"
        .CommandType = adCmdStoredProc        'its a stored procedure
        .Parameters.Append .CreateParameter("TransportID", adBigInt, adParamInput, , Me.txtTransportID.Text)
        .Execute
    End With
   
    'now we need to update the recordset
    'so that we tell the application
    'that the transport has been sent to excel
    Dim strExecute As String
   
    strExecute = "UPDATE Transports SET TSent=1 WHERE TransportID= " & Me.txtTransportID.Text
    objConn.Execute (strExecute)
    Call ReleaseConnection
    Me.chkTSent.Value = 1
    Me.Refresh
    Call RefreshTCGrid
  End If
 
Done:
Me.lblkleur.Width = 0
Me.percent.Caption = ""
Me.lblFunction.Caption = ""
Set objXLDBTWrkSht = Nothing
objXLDBTWkBk.Close SaveChanges:=False
Set objXLDBTWkBk = Nothing
Exit Function

Err_Handler:
MsgBox Err.Description, vbCritical, "Error #: " & Err.Number
Resume Done

End Function

---

Yes that function is long...I had to take some of that code from a macro of an excel sheet.

But im still wondering why I get that error at the save line I had posted. Can anyone shed some light?

Thanks,
Jon