Condition #1002 -Listman- 0737 (Wierd memory leaks issues)

I have been working eternally on an vba application that takes information from a DB (text and filenames) and edits text fields, imports drawings and bitmaps into a template. When its complete its actions it saves the template as a new file, a few different PDF files (low res, high res) and Illustrator AI.

Things have been bumpy here an there but most of the time i can get over the issue; this problem is strange.

My program loops through and creates 180 templates with text and graphics. During my tests I usually ran it for 1-10 as it takes a lot of time to go through 10 let alone 180. The script ran reasonably well. When I tried to do the whole batch (180) corel draw would start throwing up errors after a period of time.

Corel Condition #1002 -Listiman- 0737
Unexpected Condition Encountered. Please refer to the technical Support help
[ok]

Then a batch of other windows would pop up saying things (but not always the same)

Method 'Save as' of object 'Idrawdocument' failed
[ok][help]

or

Method 'PublishToPDF' of object 'Idrawdocument' failed
[ok][help]

then it would bomb the display (Corel's refresh or interface) would not recover and this error would showup:

Out of Disk Space [ok]

So I decided to check what the swapping and memory setting were in tools->options. I boosted the available memory to Corel; made the swapping disks go to a drive that had 30 gigs of space on it and ran the script with the same results.

My machine is 2 ghrz p4 with a gig of ram running windows 2000 with all service packs (corel and OS).

I opened up the task manager to check the progress of the script as it ran again. Here is the memory usuage I tracked:

(# is the number of docs that have been saved)

# Mem Use
1 : 62, 500 K (This is the first Document see following notes about it)
52 : 67, 000 K
67 : 74, 000 K
93 : 82, 000 K
116 : 93, 000 K
134 : 104, 000 K
138 : 104, 620 K (boooom)

Sometimes the script makes it to 150 sometime it doesn't. When the script starts up the memory usuage goes through the roof and then comes back to settle. I have seen it start at 62 MB then jump to 90 MB then to 120 MB, 133 MB then back around 66 MB. Then the second or third output doucments it relaxes and rises slowly as portrayed in the table above.

I disabled all the saving routines for PDF, AI and left the CDR save. Same situation.

I set all my objects to nothing after they have been used. Has anyone else encountered this behavior? I can post my application; but its not a small segment of code (and I am rather embarassed to show it ).
[internal dialog with self...] ok, I'll show it. I learn from other people laughing at my code

I know that I have something that is bloating and expanding corel memory use. Hopefully someone can find my culprit. Thank you for reading this far and thanks for being sadistic enough to continue reading...

Sub MCP()

Application.Optimization = True


Dim s As Shape
Dim i As Integer
Dim Spacer As String

Spacer = "[=-----------------------------------------------------=]"

'this is log entry setup
Open "C:\!MCP\!log-mcp.txt" For Output As #1
    
LogEntry ("-=-=-=MCP Started: " & Date)
LogEntry (Spacer)


'Do File Cleanup (Create or Cleanup Necessary Folders for Output)

Dim fs
Set fs = CreateObject("Scripting.FileSystemObject")

If fs.folderexists("c:\!mcp\created\") Then fs.deletefolder ("c:\!mcp\created")

fs.createfolder ("c:\!mcp\created\")
fs.createfolder ("c:\!mcp\created\cdr\")
fs.createfolder ("c:\!mcp\created\ai\")
fs.createfolder ("c:\!mcp\created\pdf_low")
fs.createfolder ("c:\!mcp\created\pdf_high")

Set fs = Nothing

'Connect to DB and get your data

Dim conn As ADODB.Connection
Set conn = New ADODB.Connection

With conn
    .Provider = "SQLOLEDB"
    .ConnectionString = _
        "data source=JANGOX;user id=saX1;initial catalog=eq71"
    .Open
End With

Dim rs
Dim f As String
Dim filename As String
Dim Doc As Document
Dim total_tenants

' recordset string

Set rs = conn.Execute("SELECT * FROM PROPERTIES ORDER BY P_NAME")
' Set rs = conn.Execute("SELECT TOP 10 * FROM PROPERTIES ORDER BY P_NAME")
LogEntry ("-=-=-=DB Server: Recordset Open")


i = 0
Dim x, y
Dim opt As New StructSaveAsOptions

'----------------------------------------------------------------------------------- Main Loop
LogEntry (Spacer)
LogEntry ("-=-=-==Start Recordset Loop")
LogEntry (Spacer)

Do Until rs.EOF

i = i + 1

LogEntry (("-=-=-=" & i & ": " & rs("p_name") & ": " & "Processing.."))

'Copy a working template (we don't edit the original)

LogEntry ("Copying Template..")
Set fs = CreateObject("Scripting.FileSystemObject")
fs.copyfile "c:\!mcp\!templates\Template5.cdr", "c:\!MCP\", True
Set fs = Nothing

'LogEntry ("Opening Template..")

Set Doc = OpenDocument("c:\!MCP\Template5.cdr")
DoEvents

' Front Page Modifcations (this template has mulitple pages)
LogEntry ("-=-=-=Text Replacement (Front Page)")

' Title segment with Property Name, City and State
x = TextReplacer(Doc, (rs("p_name")), 1, "p_name")
x = TextReplacer(Doc, (rs("p_address") & " " & rs("p_city") & ", " & rs("p_state") & " " & rs("p_zip")), 1, "p_address")

' Demographic Highlights
x = TextReplacer(Doc, (rs("p_p1")), 1, "p_p1")
x = TextReplacer(Doc, (rs("p_p3")), 1, "p_p3")
x = TextReplacer(Doc, (rs("p_p5")), 1, "p_p5")
x = TextReplacer(Doc, (rs("p_ahi1")), 1, "p_ahi1")
x = TextReplacer(Doc, (rs("p_ahi3")), 1, "p_ahi3")
x = TextReplacer(Doc, (rs("p_ahi5")), 1, "p_ahi5")
x = TextReplacer(Doc, (rs("p_nh1")), 1, "p_nh1")
x = TextReplacer(Doc, (rs("p_nh3")), 1, "p_nh3")
x = TextReplacer(Doc, (rs("p_nh5")), 1, "p_nh5")

LogEntry ("-=-=-=Graphics Replacement (Front Page).")

' Main aerial picture
x = GraphicsReplacer(Doc, 1, "p_picture", ("c:\!mcp\!templates\pictures\" & ("placeholder.jpg")))

' Map Picture
x = GraphicsReplacer(Doc, 1, "p_map", ("c:\!mcp\!templates\pictures\" & ("icon.jpg")))

' Icons
x = GraphicsReplacer(Doc, 1, "logo1", ("c:\!mcp\!templates\logos\" & ("anchor" & rs("p_anchor_1") & ".ai")))
x = GraphicsReplacer(Doc, 1, "logo2", ("c:\!mcp\!templates\logos\" & ("anchor" & rs("p_anchor_2") & ".ai")))
x = GraphicsReplacer(Doc, 1, "logo3", ("c:\!mcp\!templates\logos\" & ("anchor" & rs("p_anchor_3") & ".ai")))
x = GraphicsReplacer(Doc, 1, "logo4", ("c:\!mcp\!templates\logos\" & ("anchor" & rs("p_anchor_4") & ".ai")))


' Have to figure out how many tenants there are and remove the extra page 2(back templates)
' There are three Page two's each has slots for more tenants, depending on how many tennants we have to remove the excess page 2 (back) templates

'  Back Page Modifcations

Dim conn2 As ADODB.Connection
Dim rs2

Set conn2 = New ADODB.Connection

With conn2
    .Provider = "SQLOLEDB"
    .ConnectionString = _
        "data source=JANGOX;user id=saX1;initial catalog=eq71"
    .Open
End With

total_tenants = 0

Dim sqlstring As String
sqlstring = "select * from vacancy where  (de_square_feet NOT LIKE '0') and de_property_number='" & rs("p_sky_id") & "'"

Set rs2 = conn2.Execute(sqlstring)
Do Until rs2.EOF
total_tenants = total_tenants + 1
rs2.MoveNext
Loop

'sqlstring = "select top 9 * from vacancy where (de_vacant_indicator like 'O%%') and (de_occupant_name is not null) and (de_occupant_name not like '') and de_property_number=" & rs("p_sky_id")
sqlstring = "select * from vacancy where (de_square_feet NOT LIKE '0') and (de_vacant_indicator like 'O%%') and (de_occupant_name is not null) and (de_occupant_name not like '') and de_property_number='" & rs("p_sky_id") & "'"

Set rs2 = conn2.Execute(sqlstring)
Dim vcounter
Do Until rs2.EOF
vcounter = vcounter + 1
rs2.MoveNext
Loop


' At this point we can pick our templates for page #2. Vcounter is the # of records int he sql call
' And each column is 9 records long, Our first Back Page has 18, second 27 and third... so on.
' The following is for figuring out which page we are using

Select Case total_tenants

    Case 1 To 20
        Doc.Pages(3).Delete
          Doc.Pages(3).Delete
    Case 21 To 30
        Doc.Pages(2).Delete
         Doc.Pages(3).Delete
    Case 31 To 100
    Doc.Pages(3).Delete
      Doc.Pages(2).Delete
   End Select

'layout Picture
x = GraphicsReplacer(Doc, 2, "p_layout", ("c:\!mcp\!templates\pictures\" & ("placeholder.jpg")))
x = GraphicsReplacer(Doc, 2, "p_layout", ("c:\!mcp\!templates\pictures\" & ("placeholder.jpg")))

LogEntry ("-=-=-=Text Replacement (Back Page)")

' Title segment with Property Name, City and State
x = TextReplacer(Doc, (rs("p_name")), 2, "p_name")
x = TextReplacer(Doc, ("Total square feet: " & rs("p_sqf")), 2, "p_sqf")


If total_tenants >= 30 Then
    vcounter = 0
    
    Set rs2 = conn2.Execute(sqlstring)
    Do Until rs2.EOF
    vcounter = vcounter + 1
    
    Select Case vcounter
    
    Case 1 To 12
        x = TextAppender(Doc, (rs2("de_unit_number")), 2, "t_unit_number1")
        x = TextAppender(Doc, (rs2("de_occupant_name")), 2, "t_tenant1")
        x = TextAppender(Doc, ((FormatNumber(rs2("de_square_feet"), 0, vbFalse, vbFalse, vbTrue)) & " SF"), 2, "t_sqft1")
    Case 13 To 24
        x = TextAppender(Doc, (rs2("de_unit_number")), 2, "t_unit_number2")
        x = TextAppender(Doc, (rs2("de_occupant_name")), 2, "t_tenant2")
        x = TextAppender(Doc, ((FormatNumber(rs2("de_square_feet"), 0, vbFalse, vbFalse, vbTrue)) & " SF"), 2, "t_sqft2")
    Case 25 To 36
        x = TextAppender(Doc, (rs2("de_unit_number")), 2, "t_unit_number3")
        x = TextAppender(Doc, (rs2("de_occupant_name")), 2, "t_tenant3")
        x = TextAppender(Doc, ((FormatNumber(rs2("de_square_feet"), 0, vbFalse, vbFalse, vbTrue)) & " SF"), 2, "t_sqft3")
    Case 37 To 48
        x = TextAppender(Doc, (rs2("de_unit_number")), 2, "t_unit_number4")
        x = TextAppender(Doc, (rs2("de_occupant_name")), 2, "t_tenant4")
        x = TextAppender(Doc, ((FormatNumber(rs2("de_square_feet"), 0, vbFalse, vbFalse, vbTrue)) & " SF"), 2, "t_sqft4")
    Case 49 To 60
        x = TextAppender(Doc, (rs2("de_unit_number")), 2, "t_unit_number5")
        x = TextAppender(Doc, (rs2("de_occupant_name")), 2, "t_tenant5")
        x = TextAppender(Doc, ((FormatNumber(rs2("de_square_feet"), 0, vbFalse, vbFalse, vbTrue)) & " SF"), 2, "t_sqft5")
    Case 61 To 72
        x = TextAppender(Doc, (rs2("de_unit_number")), 2, "t_unit_number6")
        x = TextAppender(Doc, (rs2("de_occupant_name")), 2, "t_tenant6")
        x = TextAppender(Doc, ((FormatNumber(rs2("de_square_feet"), 0, vbFalse, vbFalse, vbTrue)) & " SF"), 2, "t_sqft6")
    
    
    End Select
    
    rs2.MoveNext
    Loop
    

Else
    
    vcounter = 0
    
    Set rs2 = conn2.Execute(sqlstring)
    Do Until rs2.EOF
    vcounter = vcounter + 1
    
    Select Case vcounter
    
    Case 1 To 10
        x = TextAppender(Doc, (rs2("de_unit_number")), 2, "t_unit_number1")
        x = TextAppender(Doc, (rs2("de_occupant_name")), 2, "t_tenant1")
        x = TextAppender(Doc, ((FormatNumber(rs2("de_square_feet"), 0, vbFalse, vbFalse, vbTrue)) & " SF"), 2, "t_sqft1")
    Case 10 To 20
        x = TextAppender(Doc, (rs2("de_unit_number")), 2, "t_unit_number2")
        x = TextAppender(Doc, (rs2("de_occupant_name")), 2, "t_tenant2")
        x = TextAppender(Doc, ((FormatNumber(rs2("de_square_feet"), 0, vbFalse, vbFalse, vbTrue)) & " SF"), 2, "t_sqft2")
    Case 21 To 30
        x = TextAppender(Doc, (rs2("de_unit_number")), 2, "t_unit_number3")
        x = TextAppender(Doc, (rs2("de_occupant_name")), 2, "t_tenant3")
        x = TextAppender(Doc, ((FormatNumber(rs2("de_square_feet"), 0, vbFalse, vbFalse, vbTrue)) & " SF"), 2, "t_sqft3")
    
    End Select
    
    rs2.MoveNext
    Loop
End If

vcounter = 0

sqlstring = "select * from vacancy where (de_vacant_indicator LIKE 'V') AND (de_square_feet NOT LIKE '0') and de_property_number=" & rs("p_sky_id")
Set rs2 = conn2.Execute(sqlstring)

Do Until rs2.EOF
vcounter = vcounter + 1
rs2.MoveNext
Loop

If vcounter = 0 Then
 x = TextAppender(Doc, (" "), 2, "v_space")
    x = TextAppender(Doc, (" "), 2, "v_sqft")
Else

Set rs2 = conn2.Execute(sqlstring)

Do Until rs2.EOF
 x = TextAppender(Doc, (rs2("de_unit_number")), 2, "v_space")
 x = TextAppender(Doc, ((FormatNumber(rs2("de_square_feet"), 0, vbFalse, vbFalse, vbTrue)) & " SF"), 2, "v_sqft")

rs2.MoveNext
Loop

End If

x = TextReplacer(Doc, ("Number of tenants: " & total_tenants), 2, "num_tenants")

Set rs2 = Nothing

conn2.Close
Set conn2 = Nothing


' Create a root file name for the differnt formats to use
filename = Replace(rs("p_name"), " ", "")
filename = filename

'Save a CDR Version
LogEntry (("Saving CDR Template as: " & FileName & ".cdr"))
    opt.EmbedICCProfile = False
    opt.EmbedVBAProject = False
    opt.Filter = cdrCDR
    opt.IncludeCMXData = False
    opt.Overwrite = True
    opt.Range = cdrAllPages
    opt.ThumbnailSize = cdr10KColorThumbnail
    opt.Version = cdrVersion11
    
Doc.SaveAs (("c:\!mcp\created\cdr\" & filename & ".cdr"))

'Save a Low Resolution PDF (For Website)
'LogEntry ("***Low Resolution PDF Save (For Web).")

'ActiveDocument.PDFSettings.PublishRange = pdfWholeDocument
'ActiveDocument.PublishToPDF (("c:\!mcp\created\pdf_low\" & filename & ".pdf"))

'Save a High Resolution PDF (For Print)
'LogEntry ("***High Resolution PDF Save (For Print).")

'ActiveDocument.PDFSettings.PublishRange = pdfWholeDocument
'ActiveDocument.PublishToPDF (("c:\!mcp\created\pdf_high\" & filename & ".pdf"))

Doc.Dirty = False

Doc.Close

LogEntry (("-=-=-=" & rs("p_name") & ": " & "Complete.."))
LogEntry (Spacer)

'Main RS loop ends
rs.MoveNext
Loop

Set rs = Nothing
LogEntry (Spacer)
LogEntry ("-=-=-=DB Dump of Property tables: END")
LogEntry (Spacer)

'Close Connections to various resources and files
conn.Close
Set conn = Nothing

LogEntry ("-=-=-=MCP Normal Shutdown")
Close #1
Application.Optimization = False
End Sub


Sub Status(StatusText As String)
    Dim s As Shape
        For Each s In ActivePage.FindShapes(Name:="FileName", Type:=cdrTextShape)
        s.Text.Contents = StatusText
        Print #1, (StatusText)
    Next s
   
End Sub
Sub LogEntry(LogText As String)
   
   Print #1, (LogText)
   
End Sub

Private Function TextReplacer(Doc As Document, NewText As String, pagenum As Long, ObjectIDx As String)
        Dim s As Shape
        
        If NewText = "" Then NewText = "N/A"
        If NewText = vbNullChar Then NewText = "N/A"
        
        For Each s In Doc.Pages(pagenum).FindShapes(Name:=ObjectIDx, Type:=cdrTextShape)
            DoEvents
            s.Text.Contents = NewText
          'Print #1, (("Text Replacer ------->" & ObjectIDx & " :" & NewText))
        Next s
End Function

Private Function TextAppender(Doc As Document, NewText As String, pagenum As Long, ObjectIDx As String)
        Dim s As Shape
        
        If NewText = Null Then NewText = "N/A"
        If NewText = vbNullChar Then NewText = "N/A"
        
        For Each s In Doc.Pages(pagenum).FindShapes(Name:=ObjectIDx, Type:=cdrTextShape)
            DoEvents
            s.Text.Contents = s.Text.Contents & NewText & vbNewLine
          'Print #1, (("Text Replacer ------->" & ObjectIDx & " :" & NewText))
        Next s
End Function

Private Function GraphicsReplacer(Doc As Document, pagenum As Long, placeholder As String, filename As String)

    Dim zulu As Shape
    Dim picname As String
    Dim fs
    
    picname = filename
    
    Set fs = CreateObject("Scripting.FileSystemObject")
    'LogEntry ("Checking for external Media Files")
    
    If (fs.fileexists(picname) = False) Then
        picname = "c:\!mcp\!templates\pictures\placeholder.jpg"
        'LogEntry ("!!!!!!!!Warning: Missing Picture for this Property! [placeholder.jpg] used instead")
    End If
    
    Dim xx As Double, yy As Double
    Dim sx As Double, sy As Double
    Dim picshape As Shape
    
    
    For Each zulu In Doc.Pages(pagenum).FindShapes(Name:=placeholder, Type:=cdrRectangleShape)
        zulu.GetBoundingBox xx, yy, sx, sy
        Doc.Pages(pagenum).ActiveLayer.Import picname
        Doc.ActiveShape.Name = (placeholder & "_pic")
        DoEvents
        For Each picshape In Doc.Pages(pagenum).FindShapes(Name:=(placeholder & "_pic"), Type:=cdrBitmapShape)
            DoEvents
            picshape.SetBoundingBox xx, yy, sx, sy, True, cdrCenter
        
        Next picshape
    For Each picshape In Doc.Pages(pagenum).FindShapes(Name:=(placeholder & "_pic"), Type:=cdrGroupShape)


            DoEvents
            picshape.SetBoundingBox xx, yy, sx, sy, True, cdrCenter
        
        Next picshape
    
    Next zulu
   
 End Function

Wow you made it to the end.. thanks again