vba - random fail on CreateObject

[ClimoC]

Hello,

does anyone know why 75% of the time:

Dim xlapp as object

retrypoint:
On error resume next
err.clear
set xlapp = createobject("Excel.Application")

if xlapp = empty then goto retrypoint

err.clear
on error goto 0

works perfectly well, and my 8 modules of macros run just fine, but the other 25% of the time, I either get "ActiveX cannot create the component", or "Automation Error, the remote call procedure failed" etc etc.

Previously, before I tried to get it to double check it successfully created the object, it would proceed along its merry way until it came time to actually use an excel application property or object, like 'xlapp.book.sheets(1).cells.sort [etc etc]', and then give me an error because the xlapp was never created?

We have a series of important macros used for keeping everything up to date, and though there are smarter ways to do it, this is what the boss says to do so I have to code it.

It's doing our collective heads in when it keeps failing.

ALSO: When it does fail, I debug, and drag the 'yellow arrow' thingy back up to the 'CreateObject' line, either step through that line or press play, it all works!

I've even tried putting in 'waits' in case it was running too quickly to catch up with itself (16GB ram and a quad core I'm working on), and it doesn't seem to make a difference if I clear out all processes of Excel first or not...

I have Office 2003, and my ref libraries being used are a couple of office object ones (Project, Word, and Excel), Microsoft Scripting Runtime, and Visual Basic For Applications Extensibility 5.3

Any ideas anyone? similar problems where it only sometimes fails?

Ta
C

 

[xenou]

Hard to say. Where are you running this code from (if not from Excel?)

Also, this is the wrong test:

if xlapp = empty then goto retrypoint

Should be:

if xlapp [B]Is Nothing [/B]Then goto retrypoint

Though seems pointless to try creating the object over and over again if its not working.

 

[Colin Legg]

Also, try working through this article to see if it turns up anything:

http://support.microsoft.com/kb/828550

 

[boblarson]

This makes no sense -

set xlapp = createobject("Excel.Application")

if xlapp = empty then goto retrypoint

If you CreateObject then it gets created. You would do the test BEFORE HAND to see if it needed to be created:

If xlapp Is Nothing Then
   Set xlapp = CreateObject("Excel.Application")
End If

Also, the rest of your code could shed light on why it is occasionally failing.

And even more important - Do NOT use On Error Resume Next because that will obscure any problems you might be having which need to be addressed. That is one bit of code which should hardly be used but many times is over used by people.

 

[ClimoC]

Well, specifically from Project. But surely you all agree it makes no difference what the source application is. If you have the Object library loaded, the only difference is that 'application' when you're in MSP vbe means Project rather than Excel.

The 'incorrect' error handler I have in place has reduced the frequency of the errors, but they still occur as I said 1/4 - 1/5 times it is run. I create the object, there is 'no error', and then when it comes to a line 20 lines later in the script that starts dealing with the objects (fully justified arguments too), it sometimes fails and sometimes doesn't. Most notably, it will fail with one of the aformentioned errors, I click stop in VBE, then run it again, and it all works magically! And sometimes it runs straight away! Its happened so many times and when it does fail, it's always on the first line that mentions the 'xlapp' object.

 

[boblarson]

I'll say it again - post the actual code and we might be able to assist. If you don't then there's no way we can.

 

[Norie]

The Object Library for Excel being 'loaded' shouldn't make a difference, partly because you don't actually need for this sort of thing.

One thing I would suggest you do is remove the On Error Resume Next bit.

Then you might find out what the problem is.

Also if you are running this code multiple times you could be ending up with multiple instances of Excel floating about.

Don't know if the no of currently open instances of an application affects creating an new instance using CreateObject.

If it does then it might be specific to the application in question.

eg once you've got 4 instances of Excel kicking about, VBA things you're joking when you want to open another one.

Another thing is, if you do have the relevant libraries open then why not use them.

Set xlApp = New Excel.Application

 

[xenou]

It's unusual to have the problems you describe. Many good suggestions above worth consideration - this is not any easy one to see an answer to right away.

 

[ClimoC]

First (of many) bits in the overall process, build array and dump to excel sheet

Option Explicit

Const xlToRight = -4161
Const xlDown = -4121

Const COLRECORDID = 1
Const COLFMIDX = 2
Const COLJOB = 3
Const COLUNITNAME = 4
Const COLSHOTNAME = 5
Const COLDEPTNAME = 6
Const COLJOBTYPE = 7
Const COLFULLNAME = 8
Const COLSTART = 9
Const COLBID = 10
Const COLPAD = 11
Const COLEXTDELAY = 12
Const COLFINISH = 13
Const COLWORK = 14
Const COLUNIQUEID = 15
Const COLTNOTES = 16
Const COLLOGINID = 17
Const COLCDD = 18
Const COLSTATUSM = 19
Const COLTASKSTAT = 20
Const COLSSSTART = 21
Const COLSSDUE = 22
Const COLSCHCHANGES = 23


Const TEMPLATEPROJ = "C:\FMexport\FM Import Project 2.mpt"
    Global filtername As String
    Global count As Long
    Global count2 As Long
    Global count3 As Long
    Global outwardfile As String
    Global inwardfile As String
    Public OutArray() As Variant
    Public newtaskarray() As Variant
    Public filterinitials As String
    Public OutArrayALL() As Variant
    Global unitname As String
    Global deptname As String
    Global dptcnt As Integer
    Global untcnt As Integer
    Global resuming As Boolean
    

Sub MSPExport()

If forceclose = True Then Exit Sub
If resuming = True Then GoTo andnowformynexttrick


    Dim dup As task
    Set dup = CheckForDupRecordIDs()
    If Not dup Is Nothing Then
        Call MsgBox(Prompt:="Duplicate Task id" & dup & ": " & dup.Text18 & " for " & dup.OutlineParent.name, _
            Buttons:=vbExclamation, title:="Export Error")
        Exit Sub
    End If

andnowformynexttrick:
Dim i As Integer, j As Integer

Dim selectedCount1 As Integer
For i = 0 To MSPExportForm.ListBox1.ListCount - 1
    If MSPExportForm.ListBox1.Selected(i) Then selectedCount1 = selectedCount1 + 1
Next i

Dim selectedcount2 As Integer
For j = 0 To MSPExportForm.ListBox2.ListCount - 1
    If MSPExportForm.ListBox2.Selected(j) Then selectedcount2 = selectedcount2 + 1
Next j

    ReDim OutArray(ActiveProject.Tasks.count, 50)
    count = 0
    ReDim newtaskarray(ActiveProject.Tasks.count, 50)
    count2 = 0
    ReDim OutArrayALL(ActiveProject.Tasks.count, 30)
    count3 = 0
    
    OutArray(count, COLRECORDID - 1) = "RecordID"
    OutArray(count, COLFMIDX - 1) = "fmidx"
    OutArray(count, COLJOB - 1) = "job"
    OutArray(count, COLNAME - 1) = "name"
    OutArray(count, COLJOBTYPE - 1) = "task"
    OutArray(count, COLSTART - 1) = "Start"
    OutArray(count, COLFINISH - 1) = "actualEnd"
    OutArray(count, COLFULLNAME - 1) = "userName"
    OutArray(count, COLDEPTNAME - 1) = "Dept"
    OutArray(count, COLWORK - 1) = "Work"
    OutArray(count, COLTNOTES - 1) = "taskNotes"
    OutArray(count, COLUNIQUEID - 1) = "uniqueID"
    OutArray(count, COLUNITNAME - 1) = "Unit"
    OutArray(count, COLBID - 1) = "cost1"
    OutArray(count, COLPAD - 1) = "cost2"
    OutArray(count, COLEXTDELAY - 1) = "EXTdelay"
    OutArray(count, COLSTATUSM - 1) = "statusMaster"
    OutArray(count, COLTASKSTAT - 1) = "taskStatus"
    OutArray(count, COLLOGINID - 1) = "loginID"
    OutArray(count, COLSSSTART - 1) = "subsetStart"
    OutArray(count, COLSSDUE - 1) = "subsetDue"
    OutArray(count, COLSCHCHANGES - 1) = "ScheduleChange"
    count = count + 1
    
    OutArrayALL(count3, COLRECORDID - 1) = "RecordID"
    OutArrayALL(count3, COLFMIDX - 1) = "fmidx"
    OutArrayALL(count3, COLJOB - 1) = "job"
    OutArrayALL(count3, COLNAME - 1) = "name"
    OutArrayALL(count3, COLJOBTYPE - 1) = "task"
    OutArrayALL(count3, COLSTART - 1) = "Start"
    OutArrayALL(count3, COLFINISH - 1) = "actualEnd"
    OutArrayALL(count3, COLFULLNAME - 1) = "userName"
    OutArrayALL(count3, COLDEPTNAME - 1) = "Dept"
    OutArrayALL(count3, COLWORK - 1) = "Work"
    OutArrayALL(count3, COLTNOTES - 1) = "taskNotes"
    OutArrayALL(count3, COLUNIQUEID - 1) = "uniqueID"
    OutArrayALL(count3, COLUNITNAME - 1) = "Unit"
    OutArrayALL(count3, COLBID - 1) = "bid"
    OutArrayALL(count3, COLPAD - 1) = "pad"
    OutArrayALL(count3, COLEXTDELAY - 1) = "EXTdelay"
    OutArrayALL(count3, COLCDD - 1) = "clientDueDate"
    OutArrayALL(count3, COLSTATUSM - 1) = "statusMaster"
    OutArrayALL(count3, COLTASKSTAT - 1) = "taskStatus"
    OutArrayALL(count3, COLLOGINID - 1) = "loginID"
    OutArrayALL(count3, COLSSSTART - 1) = "subsetStart"
    OutArrayALL(count3, COLSSDUE - 1) = "subsetDue"
    OutArrayALL(count3, COLSCHCHANGES - 1) = "ScheduleChange"
    count3 = count3 + 1
        
    newtaskarray(count2, COLRECORDID - 1) = "RecordID"
    newtaskarray(count2, COLFMIDX - 1) = "fmidx"
    newtaskarray(count2, COLNAME - 1) = "name"
    newtaskarray(count2, COLJOBTYPE - 1) = "task"
    newtaskarray(count2, COLSTART - 1) = "Start"
    newtaskarray(count2, COLJOB - 1) = "Job"
    newtaskarray(count2, COLFINISH - 1) = "actualEnd"
    newtaskarray(count2, COLFULLNAME - 1) = "userName"
    newtaskarray(count2, COLDEPTNAME - 1) = "deptName"
    newtaskarray(count2, COLWORK - 1) = "Work"
    newtaskarray(count2, COLTNOTES - 1) = "taskNotes"
    newtaskarray(count2, COLDEPTNAME - 1) = "Dept"
    newtaskarray(count2, COLUNIQUEID - 1) = "uniqueID"
    newtaskarray(count2, COLUNITNAME - 1) = "Unit"
    newtaskarray(count2, COLBID - 1) = "bid"
    newtaskarray(count2, COLPAD - 1) = "pad"
    newtaskarray(count2, COLEXTDELAY - 1) = "EXTdelay"
    newtaskarray(count2, COLSTATUSM - 1) = "statusMaster"
    newtaskarray(count2, COLTASKSTAT - 1) = "taskStatus"
    newtaskarray(count2, COLCDD - 1) = "clientDueDate"
    newtaskarray(count2, COLLOGINID - 1) = "loginID"
    newtaskarray(count2, COLSSSTART - 1) = "subsetStart"
    newtaskarray(count2, COLSSDUE - 1) = "subsetDue"
    newtaskarray(count2, COLSCHCHANGES - 1) = "ScheduleChange"
    count2 = count2 + 1
    
If selectedCount1 = 0 Or selectedcount2 = 0 Then
    MsgBox ("You must select one or more shows from the list")
Else
    Dim t As task
    For Each t In ActiveProject.Tasks
        If isittheend(t) = True And t.Text1 <> "Subset" Then
            AddtoallArray t
            For i = 0 To MSPExportForm.ListBox1.ListCount - 1
                If MSPExportForm.ListBox1.Selected(i) Then
                For j = 0 To MSPExportForm.ListBox2.ListCount - 1
                    If MSPExportForm.ListBox2.Selected(j) Then
                    If t.Text11 = MSPExportForm.ListBox2.List(j) And t.Text3 = MSPExportForm.ListBox1.List(i) Then
                        If t.Text1 <> "Subset" Then AddtoArrays t
                    End If
                    End If
                Next j
                End If
            Next i
        End If
    Next t



outwardfile = "MSPExport_" & wayinit & "_options_" & testorreal & ".xls"
inwardfile = "FMExport_" & testorreal & "_" & wayinit & ".xls"


    'create a new workbook
    Dim ExcelApp As Object, NewBook As Object, Sheet As Object, alltsheet As Object
    Dim newtsheet As Object, newtasks As Object, AllTasks As Object
    Dim theoutput As WorkBook, theoutput2 As WorkBook, alloutput As WorkBook
retry:
    
    Set ExcelApp = CreateObject("Excel.Application")
err.Clear
On Error Resume Next
    Set NewBook = ExcelApp.Workbooks.Add
If err.Number <> 0 Then GoTo retry
On Error GoTo 0
    Set Sheet = NewBook.ActiveSheet

    Set theoutput = ExcelApp.ActiveWorkbook

    Set newtasks = ExcelApp.Workbooks.Add

    Set newtsheet = newtasks.ActiveSheet

    Set theoutput2 = ExcelApp.ActiveWorkbook

    Set AllTasks = ExcelApp.Workbooks.Add

    Set alltsheet = AllTasks.ActiveSheet

    Set alloutput = ExcelApp.ActiveWorkbook

    
    ExcelApp.Visible = True
    ExcelApp.ScreenUpdating = True

    Sheet.Range(Sheet.Cells(1, 1), Sheet.Cells(ActiveProject.Tasks.count, 50)).value = OutArray
    
    newtsheet.Range(newtsheet.Cells(1, 1), newtsheet.Cells(ActiveProject.Tasks.count, 50)).value = newtaskarray
    
    alltsheet.Range(alltsheet.Cells(1, 1), alltsheet.Cells(ActiveProject.Tasks.count, 50)).value = OutArrayALL
    
    ExcelApp.DisplayAlerts = False

So that's just the first bit...

So for 75% of the time, this all works fine. But the rest of the time, it errors at either of the two yellow lines.

PS - there are a few global variables in here, used to keep thing flowing smoothly if someone breaks a procedure or clicks cancel buttos in userforms etc.

If it fails on CreateObject, it's usually "ActiveX could not create the component" and if it's the add workbook bit it's usually "Automation Error. The Remote call procedure failed"

 

[Norie]

Have you tried removing the On Error stuff?

That's not going to solve the problem but it should give you a clearer picture of what's happening.

Also, if you do have a reference set to the Excel Object library, use it.

The code you've posted so far doesn't and in fact it doesn't need it.

Another thing, why all the array stuff - can you not use the Project Object model?

Even if you do eventually need the arrays I'm pretty sure there's a more efficient way of populating them.

Finally, and I apologise if this has all been a bit negative, there could be better ways to handle the listboxes.