![]() |
|
![]() |
|
Thread Tools | Search this Thread | Display Modes |
#1
|
|||
|
|||
![]()
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... Code:
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 ![]() |
#2
|
||||
|
||||
![]()
It's difficult to try and locate the source of the problem. It even could be that CorelDRAW always leaks some memory even when you open/close documents manually. It is just quite difficult to reproduce, however through VBA you just fire up a macro that does opening/closing hundreds of times and you can easily see the problem.
I just tried to open and close a simple document 500 times and there were no apparent memory leaks, so there must be something specific to your program. Maybe some objects that you used inside CorelDRAW object model which caused memory leaks. I cannot test your program much because I don't have the template files and the database which you have. However, maybe you can play a little bit with it. Try commening out some parts of your program. Start with just opening the files and immediately closing them. Then add some object processing, and keep adding the code back until you locate the source of the problem. I'd be interested to know about your findings, so keep me posted. |
#3
|
|||
|
|||
![]()
I went throught and tried different loops; ones with only open file calls, Open and Save, DB no DB etc.
The script in its most stripped down state: Code:
Option Explicit Sub MCP() Application.Optimization = True Dim i As Integer Dim Doc As Document Dim Spacer As String Spacer = "[=-----------------------------------------------------=]" 'this is log entry setup Open "C:\!MCP\!!TESTING.txt" For Output As #1 LogEntry ("-=-=-=TESTS Started: " & Date) LogEntry (Spacer) i = 0 Do While i <> 1000 i = i + 1 LogEntry (i & ". Opening Template...") Set Doc = OpenDocument("c:\!MCP\Template5.cdr") DoEvents Doc.Dirty = False Doc.Close LogEntry ("File Closed") LogEntry (Spacer) Loop Close #1 Application.Optimization = False LogEntry ("-=-=-=TESTS ENDED: " & Date) LogEntry (Spacer) End Sub Private Function LogEntry(LogText As String) Print #1, (LogText) End Function Now, when I run this segment of Code many things happen: 1. Memory Starts at 34 MB for CORELDRW.EXE 2. START: Then memory spikes to 89, down to 50, up to 90, 48, 90, 50,89 3. After the 1 Minute mark the program rests at 48 MB 4. After about 123 itereations of the loop we get memory usuage at 50 MB 5. Program crashes with #1002-LISTMAN 0737 at 282 iterations and 53 MB 6. The file being loaded and closed is about 99 KB Any thoughts or input would be greatly appreciated.. --Wolfgang :twisted: |
#5
|
|||
|
|||
![]()
Here you go. :twisted:
--Wolfgang |
#6
|
|||
|
|||
![]()
I removed all the Logging features from the script. It lasts about 10 minutes has the same issues and ends in a listman error. I have to say that its may seem longer than the other scripts but I am not sure.
I've also noticed in my travels that this script throws up other errors (when its the full script). Most of them say soemthing about memory or out of swap space. In either situation when I monitor them they have usually half a gig left in ram (1 gig total ram in the machine). I modified the corel prefs to boost the mem usuage to 80% and I swap out to the primary HD and a secondary that have gigs of storage. --Wolfgang :twisted: |
#7
|
|||
|
|||
![]()
Running this code:
Code:
Option Explicit Sub MCP() Application.Optimization = True Dim i As Integer Dim Doc As Document i = 0 Do While i <> 1000 i = i + 1 Set Doc = CreateDocument() DoEvents Doc.Dirty = False Doc.Close Loop Application.Optimization = False End Sub |
![]() |
Currently Active Users Viewing This Thread: 1 (0 members and 1 guests) | |
Thread Tools | Search this Thread |
Display Modes | |
|
|