|
-
Apr 8th, 2003, 01:06 PM
#1
Thread Starter
Banned
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
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|