The object invoked as disconnected from its clients. - To many she

D

dan

Hi All,
I have a problem with vba code (excel macro) generating many sheets. It
seems to crush at creating 300th sheet.

I'm running it on notebook:
MS Excel 2003
Win XP SP2
1 GB RAM
Intel Pentium 1.73GHz

I've tried to run it also at another notebook:
MS Excel 2003
Win XP SP2
2 GB RAM
Core 2 Duo 2,00GHz
and i got the same error.

It stops at line:
Set NewSheet = oBook.Sheets(1)

Throwing an error:
Run-time error '-2147417848 (80010108)'
Automation error
The object invoked as disconnected from its clients.

If you can give me any hint it would be wonderful. That's not my code, I
have to workout this problem because it worked perfectly as long as it had to
generated about 150 sheets. Since the document grow bigger I had to face this
problem.

The full code:
macro name is GenerateTestScripts


Dim K_DATA0
Dim K_DATA1
Dim K_DATA2
Dim K_DATA3
Dim K_DATA4
Dim K_DATA5
Dim K_DATA6
Dim K_DATA7
Dim K_DATA8
Dim K_DATA9
Dim K_DATA10
Dim K_DATA11
Dim K_DATA12
Dim K_DATA13
Dim K_DATA14
Dim K_DATA15
Dim K_DATA16
Dim K_DATA17
Dim K_DATA18
Dim K_DATA19
Dim K_DATA20
Dim K_DATA21
Dim K_DATA22
Dim K_DATA23
Dim K_DATA24
Dim K_DATA25
Dim K_DATA26
Dim K_DATA27
Dim K_DATA28
Dim K_DATA29
Dim K_DATA30
Dim K_DATA31
Dim K_DATA32
Dim K_DATA33
Dim K_DATA34
Dim K_DATA35
Dim K_DATA36
Dim K_DATA37
Dim K_DATA38
Dim K_DATA39
Dim K_DATA40
Function SF_countLines(ByVal Haystack As String) As Long
'count the number of occurences of needle in haystack
'SF_count(" This is my string ","i") returns 3
maxCharsPerLine = 50
numlines = 0
Needle = Chr(10)
Dim i As Long, j As Long

Position = InStr(1, Haystack, Needle, vbTextCompare)
If Position = 0 Then
hsLen = Len(Haystack)
SF_countLines =
Application.WorksheetFunction.Ceiling(Len(Haystack) / maxCharsPerLine, 1)
Else

Haystack1 = Mid(Haystack, 1, Position)
Haystack2 = Mid(Haystack, Position + 1, Len(Haystack) - Position)
numlines = Application.WorksheetFunction.Ceiling(Len(Haystack1)
/ maxCharsPerLine, 1)
numlines = numlines + SF_countLines(Haystack2)

SF_countLines = numlines
End If

End Function
Function DataReplace(STRIN) As String
STRIN = Replace(STRIN, "%DATA0%", K_DATA0)
STRIN = Replace(STRIN, "%DATA1%", K_DATA1)
STRIN = Replace(STRIN, "%DATA2%", K_DATA2)
STRIN = Replace(STRIN, "%DATA3%", K_DATA3)
STRIN = Replace(STRIN, "%DATA4%", K_DATA4)
STRIN = Replace(STRIN, "%DATA5%", K_DATA5)
STRIN = Replace(STRIN, "%DATA6%", K_DATA6)
STRIN = Replace(STRIN, "%DATA7%", K_DATA7)
STRIN = Replace(STRIN, "%DATA8%", K_DATA8)
STRIN = Replace(STRIN, "%DATA9%", K_DATA9)
STRIN = Replace(STRIN, "%DATA10%", K_DATA10)
STRIN = Replace(STRIN, "%DATA11%", K_DATA11)
STRIN = Replace(STRIN, "%DATA12%", K_DATA12)
STRIN = Replace(STRIN, "%DATA13%", K_DATA13)
STRIN = Replace(STRIN, "%DATA14%", K_DATA14)
STRIN = Replace(STRIN, "%DATA15%", K_DATA15)
STRIN = Replace(STRIN, "%DATA16%", K_DATA16)
STRIN = Replace(STRIN, "%DATA17%", K_DATA17)
STRIN = Replace(STRIN, "%DATA18%", K_DATA18)
STRIN = Replace(STRIN, "%DATA19%", K_DATA19)
STRIN = Replace(STRIN, "%DATA20%", K_DATA20)
STRIN = Replace(STRIN, "%DATA21%", K_DATA21)
STRIN = Replace(STRIN, "%DATA22%", K_DATA22)
STRIN = Replace(STRIN, "%DATA23%", K_DATA23)
STRIN = Replace(STRIN, "%DATA24%", K_DATA24)
STRIN = Replace(STRIN, "%DATA25%", K_DATA25)
STRIN = Replace(STRIN, "%DATA26%", K_DATA26)
STRIN = Replace(STRIN, "%DATA27%", K_DATA27)
STRIN = Replace(STRIN, "%DATA28%", K_DATA28)
STRIN = Replace(STRIN, "%DATA29%", K_DATA29)
STRIN = Replace(STRIN, "%DATA30%", K_DATA30)
STRIN = Replace(STRIN, "%DATA31%", K_DATA31)
STRIN = Replace(STRIN, "%DATA32%", K_DATA32)
STRIN = Replace(STRIN, "%DATA33%", K_DATA33)
STRIN = Replace(STRIN, "%DATA34%", K_DATA34)
STRIN = Replace(STRIN, "%DATA35%", K_DATA35)
STRIN = Replace(STRIN, "%DATA36%", K_DATA36)
STRIN = Replace(STRIN, "%DATA37%", K_DATA37)
STRIN = Replace(STRIN, "%DATA38%", K_DATA38)
STRIN = Replace(STRIN, "%DATA39%", K_DATA39)
STRIN = Replace(STRIN, "%DATA40%", K_DATA40)

DataReplace = STRIN

End Function
Sub GenerateTestScripts()

StartConfRow = 6
SumRow = 6

max_rows = 1500
strFileName = "C:\t\out.xls"
saveFrequency = 200
Set oBook = Application.Workbooks.Open(strFileName)

Set AllSheets = oBook.Sheets("ALL")
Set BaseSheet = oBook.Sheets("BASE")
Set confSheet = oBook.Sheets("KONF")
Set SumSheet = oBook.Sheets("SUMMARY")

For i = 3 To max_rows

If i Mod saveFrequency = 0 Then
oBook.Close SaveChanges:=True
Set oBook = Nothing
Set AllSheets = Nothing
Set BaseSheet = Nothing
Set confSheet = Nothing
Set SumSheet = Nothing
Set NewSheet = Nothing
Set oBook = Application.Workbooks.Open(strFileName)

Set AllSheets = oBook.Sheets("ALL")
Set BaseSheet = oBook.Sheets("BASE")
Set confSheet = oBook.Sheets("KONF")
Set SumSheet = oBook.Sheets("SUMMARY")
End If


If (AllSheets.Range("B" + CStr(i)).Value = 1) Then
TC_ID = AllSheets.Range("K" + CStr(i)).Value
' get configurations
j = i + 1
While (AllSheets.Range("C" + CStr(j)).Value = 1)
KO_ID = oBook.Sheets("ALL").Range("N" + CStr(j)).Value
'get configuration
k = StartConfRow

While ((confSheet.Range("B" + CStr(k)).Value <> "") And
(confSheet.Range("B" + CStr(k)) <> KO_ID))
k = k + 1
Wend
'check if found or end
If (confSheet.Range("B" + CStr(k)).Value = KO_ID) Then
K_DATA0 = confSheet.Range("C" + CStr(k)).Value
K_DATA1 = confSheet.Range("D" + CStr(k)).Value
K_DATA2 = confSheet.Range("E" + CStr(k)).Value
K_DATA3 = confSheet.Range("F" + CStr(k)).Value
K_DATA4 = confSheet.Range("G" + CStr(k)).Value
K_DATA5 = confSheet.Range("H" + CStr(k)).Value
K_DATA6 = confSheet.Range("I" + CStr(k)).Value
K_DATA7 = confSheet.Range("J" + CStr(k)).Value
K_DATA8 = confSheet.Range("K" + CStr(k)).Value
K_DATA9 = confSheet.Range("L" + CStr(k)).Value
K_DATA10 = confSheet.Range("M" + CStr(k)).Value
K_DATA11 = confSheet.Range("N" + CStr(k)).Value
K_DATA12 = confSheet.Range("O" + CStr(k)).Value
K_DATA13 = confSheet.Range("P" + CStr(k)).Value
K_DATA14 = confSheet.Range("Q" + CStr(k)).Value
K_DATA15 = confSheet.Range("R" + CStr(k)).Value
K_DATA16 = confSheet.Range("S" + CStr(k)).Value
K_DATA17 = confSheet.Range("T" + CStr(k)).Value
K_DATA18 = confSheet.Range("U" + CStr(k)).Value
K_DATA19 = confSheet.Range("V" + CStr(k)).Value
K_DATA20 = confSheet.Range("W" + CStr(k)).Value
K_DATA21 = confSheet.Range("X" + CStr(k)).Value
K_DATA22 = confSheet.Range("Y" + CStr(k)).Value
K_DATA23 = confSheet.Range("Z" + CStr(k)).Value
K_DATA24 = confSheet.Range("AA" + CStr(k)).Value
K_DATA25 = confSheet.Range("AB" + CStr(k)).Value
K_DATA26 = confSheet.Range("AC" + CStr(k)).Value
K_DATA27 = confSheet.Range("AD" + CStr(k)).Value
K_DATA28 = confSheet.Range("AE" + CStr(k)).Value
K_DATA29 = confSheet.Range("AF" + CStr(k)).Value
K_DATA30 = confSheet.Range("AG" + CStr(k)).Value
K_DATA31 = confSheet.Range("AH" + CStr(k)).Value
K_DATA32 = confSheet.Range("AI" + CStr(k)).Value
K_DATA33 = confSheet.Range("AJ" + CStr(k)).Value
K_DATA34 = confSheet.Range("AK" + CStr(k)).Value
K_DATA35 = confSheet.Range("AL" + CStr(k)).Value
K_DATA36 = confSheet.Range("AM" + CStr(k)).Value
K_DATA37 = confSheet.Range("AN" + CStr(k)).Value
K_DATA38 = confSheet.Range("AO" + CStr(k)).Value
K_DATA39 = confSheet.Range("AP" + CStr(k)).Value
K_DATA40 = confSheet.Range("AR" + CStr(k)).Value

K_TESTER = confSheet.Range("A" + CStr(k)).Value


TC_TITLE = DataReplace(AllSheets.Range("L" + CStr(i)).Value)
TC_DESC = DataReplace(AllSheets.Range("M" + CStr(i)).Value)

BaseSheet.Copy Before:=oBook.Sheets(1)
Set NewSheet = oBook.Sheets(1)
NewSheet.Name = TC_ID + "_" + KO_ID
NewSheet.Range("C1:M1").Value = TC_ID
NewSheet.Range("C2:M2").Value = KO_ID
NewSheet.Range("C3:M3").Value = TC_TITLE
NewSheet.Range("B6:M6").Value = TC_DESC

'get WK
l = j + 1

rowWK = 12
rowPrev = 9
rowCase = 15
rowSum = 19
firstCaseRow = 15

While ((AllSheets.Range("B" + CStr(l)).Value <> "1") And (l <
max_rows))
' WK
If (AllSheets.Range("D" + CStr(l)).Value = "1") Then
WK = DataReplace(AllSheets.Range("O" + CStr(l)).Value)
NewSheet.Range("B" + CStr(rowWK) + ":M" +
CStr(rowWK)).Value = WK
End If

' PREV
If (AllSheets.Range("E" + CStr(l)).Value = "1") Then
NewSheet.Rows(CStr(rowPrev) + ":" +
CStr(rowPrev)).Copy
NewSheet.Rows(CStr(rowPrev) + ":" +
CStr(rowPrev)).Insert Shift:=xlDown
Application.CutCopyMode = False

NewSheet.Range("B" + CStr(rowPrev) + ":D" +
CStr(rowPrev)).Value = AllSheets.Range("P" + CStr(l)).Value

rowPrev = rowPrev + 1
rowWK = rowWK + 1
rowCase = rowCase + 1
firstCaseRow = firstCaseRow + 1
rowSum = rowSum + 1
End If
' CASE STEP
If (AllSheets.Range("G" + CStr(l)).Value = "1") Then
NewSheet.Rows(CStr(rowCase + 1) + ":" + CStr(rowCase
+ 1)).Copy
NewSheet.Rows(CStr(rowCase + 1) + ":" + CStr(rowCase
+ 1)).Insert Shift:=xlDown
Application.CutCopyMode = False

strId = DataReplace(AllSheets.Range("R" +
CStr(l)).Value)
strTitle = DataReplace(AllSheets.Range("S" +
CStr(l)).Value)
strDesc = DataReplace(AllSheets.Range("T" +
CStr(l)).Value)
strResult = DataReplace(AllSheets.Range("U" +
CStr(l)).Value)

NewSheet.Range("A" + CStr(rowCase)).Value = strId
NewSheet.Range("B" + CStr(rowCase)).Value = strTitle
NewSheet.Range("C" + CStr(rowCase) + ":G" +
CStr(rowCase)).Value = strDesc
NewSheet.Range("H" + CStr(rowCase) + ":J" +
CStr(rowCase)).Value = strResult
If (AllSheets.Range("W" + CStr(l)).Value = "1") Then
NewSheet.Range("K" + CStr(rowCase)).Value = "OK."
NewSheet.Range("N" + CStr(rowCase)).Value = 1
End If
numlines = SF_countLines(strId)

numlines =
Application.WorksheetFunction.Max(numlines, SF_countLines(strTitle))
numlines =
Application.WorksheetFunction.Max(numlines, SF_countLines(strDesc))
numlines =
Application.WorksheetFunction.Max(numlines, SF_countLines(strResult))

rowHeightMin = 24
rowHeightLine = 11.25
RowHeight =
Application.WorksheetFunction.Max((numlines + 1) * rowHeightLine,
rowHeightMin)
NewSheet.Rows(CStr(rowCase) + ":" +
CStr(rowCase)).RowHeight = RowHeight
'if always ok

rowCase = rowCase + 1
rowSum = rowSum + 1

End If
l = l + 1
Wend

NewSheet.Rows(CStr(rowPrev) + ":" + CStr(rowPrev)).Delete
Shift:=xlUp
rowCase = rowCase - 1
firstCaseRow = firstCaseRow - 1
rowSum = rowSum - 1
NewSheet.Rows(CStr(rowCase + 1) + ":" +
CStr(rowCase)).Delete Shift:=xlUp
rowSum = rowSum - 2
Application.CutCopyMode = False

'copy next do summary
SumSheet.Activate
SumSheet.Rows(CStr(SumRow + 1) + ":" + CStr(SumRow + 1)).Copy
SumSheet.Rows(CStr(SumRow + 1) + ":" + CStr(SumRow +
1)).Insert Shift:=xlDown
Application.CutCopyMode = False

'
SumSheet.Range("A" + CStr(SumRow)).Value = K_TESTER
SumSheet.Range("B" + CStr(SumRow)).Value = TC_ID
SumSheet.Range("C" + CStr(SumRow)).Value = KO_ID
SumSheet.Range("D" + CStr(SumRow)).Value = TC_TITLE
SumSheet.Hyperlinks.Add Anchor:=SumSheet.Range("B" +
CStr(SumRow) + ":D" + CStr(SumRow)), Address:="", SubAddress:="'" +
NewSheet.Name + "'!K" + CStr(firstCaseRow), TextToDisplay:=TC_ID
SumSheet.Range("E" + CStr(SumRow)).Formula = "='" +
NewSheet.Name + "'!C" + CStr(rowSum)
SumSheet.Range("F" + CStr(SumRow)).Formula = "='" +
NewSheet.Name + "'!C" + CStr(rowSum + 1)
SumSheet.Range("G" + CStr(SumRow)).Formula = "='" +
NewSheet.Name + "'!C" + CStr(rowSum + 2)
SumSheet.Range("H" + CStr(SumRow)).Formula = "='" +
NewSheet.Name + "'!C" + CStr(rowSum + 3)
SumSheet.Range("I" + CStr(SumRow)).Formula = "='" +
NewSheet.Name + "'!C" + CStr(rowSum + 4)
SumSheet.Range("J" + CStr(SumRow)).Formula = "='" +
NewSheet.Name + "'!C" + CStr(rowSum + 5)
SumSheet.Range("K" + CStr(SumRow)).Formula = "='" +
NewSheet.Name + "'!C" + CStr(rowSum + 6)

NewSheet.Activate
NewSheet.Hyperlinks.Add Anchor:=NewSheet.Range("B" +
CStr(rowSum + 8)), Address:="", SubAddress:="'" + SumSheet.Name + "'!D" +
CStr(SumRow), TextToDisplay:="<<PODSUMOWANIE"
NewSheet.Range("K" + CStr(firstCaseRow)).Select


SumRow = SumRow + 1

'Protect Sheet
NewSheet.Protect DrawingObjects:=True, Contents:=True,
Scenarios:=True
NewSheet.EnableSelection = xlUnlockedCells



j = j + 1
End If
Wend
End If
Next i

SumSheet.Activate
SumSheet.Rows(CStr(rowSum + 1) + ":" + CStr(rowSum)).Delete Shift:=xlUp

End Sub
 
T

Tim Williams

On my PC a bare-bones version of your code (below) consistently fails at
sheet 641. Excel 2002 SP3.

I think Excel might be trying to tell you something about your basic design
here: what are you planning on doing with 1500 sheets in a workbook ?

Tim


'***********************************
Option Explicit

Sub GenerateTestScripts()

Dim max_rows As Long
Dim strFileName As String
Dim saveFrequency As Long
Dim oBook As Excel.Workbook
Dim BaseSheet As Excel.Worksheet
Dim i As Long


max_rows = 1500
strFileName = ThisWorkbook.Path & "\out.xls"
saveFrequency = 200
Set oBook = Application.Workbooks.Open(strFileName)

Set BaseSheet = oBook.Sheets("BASE")

For i = 3 To max_rows

Application.StatusBar = i

If i Mod saveFrequency = 0 Then
oBook.Close SaveChanges:=True
Set oBook = Nothing
Set BaseSheet = Nothing

Set oBook = Application.Workbooks.Open(strFileName)

Set BaseSheet = oBook.Sheets("BASE")

End If
BaseSheet.Copy Before:=oBook.Sheets(1)


Next i

Application.StatusBar = False

End Sub
'***************************************
 
D

dan

Thank you for your reply.

Well, since your code doesn't do much more than creating next sheets that
may be the answer why it fails at sheet 641.
My code (doing something more) fails at sheet 300 not depending on machine
configuration. So for me it's not memory problem but some limitations (maybe
buffer) inside Excel.
I can't understand why such limitations were introduced.

Anyway it seems to be not a problem of my code but limitations of Excel. If
it's true I will have to redesign this solution as you suggested.

And answering your question - I don't want to create 1500 sheets but about
350. The code worked perfectly as long as it had to create 200 sheets, For
me it was interesting to discover why it started to throw errors after adding
a few sheets.

And I really need that code - this excel is used during tests. Each created
sheet is another Use Case with diffrent configuration (If i have 30 tests and
15 configurations it gives 450 sheets). All this sheets are conneted to the
some 'Summary' sheet. It was very useful having all the information in one
place -> because some sheets are connected with each other (you have to end
some tests before starting another ones)...
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top