Some time ago I wrote this three-part SelfCompact routine. Basically every time my project is getting too bloated I just place my cursor in the subroutine somewhere and hit the Play button and it exports itself and reimports itself and retains all the references. The nice thing is my new file is the same file I started with. "But you can't import over what you're currently running!" I hear you cry. Well, you're right, so the routine does a tricky hop-step-jump whereby it uses an intermediate copy of itself and runs some of the code from there, then when the original has been replaced it leaps back to it and tidies up the intermediate copy. Now I have thought about making it available on this forum for some time, but what held me back is that some of it is specific to my environment and there may be other things that people are doing with their projects that I haven't covered. I thought one day I'd make it more robust but I think I'm ready to admit to myself that probably won't happen, so I've decided to offer it here "as is". This is a pretty hairy topic so *please* make sure you have backups before you test this out. Once it's working in your environment though it should be fairly straightforward. I've been using it about a year now without incident. A couple of specifics to watch out for: 1. The 3 routines must reside inside the project itself. 2. It uses a file Empty.dvb that is (surprise!) a read-only clean empty dvb file. This must exist where the main project exists. 3. Part One attempts to determine where your My Documents directory is to place working files in. 4. Part One is making specific decisions about what file type and extensions to deal with. 5. My project lives on a mapped network drive P: but when the temporary copy is created the operating system substitutes the UNC (network) name back into the Path. The code needs the paths to be consistent so it does a replace on that part of the name. I had to hard-code these references to wpnt2 in Part Two and Part Three. If you're on a network you may need to use your own network information, otherwise you might be able to discard these parts altogether. 6. It uses the Microsoft Scripting Runtime library. [pre] Private Sub SelfCompact() ' By Wayne Ivory Dim I%, OldProject As Object, NewProject As Object, OldComponent As Object, ComponentPath$, fso As New Scripting.FileSystemObject Set OldProject = ThisDrawing.Application.VBE.ActiveVBProject If Not OldProject.Saved Then MsgBox "Can't compact while unsaved changes exist", vbExclamation, "SelfCompact" Exit Sub End If fso.CopyFile Replace(OldProject.FileName, OldProject.Name, "Empty"), Replace(OldProject.FileName, OldProject.Name, "SelfCompact"), True SetAttr Replace(OldProject.FileName, OldProject.Name, "SelfCompact"), vbNormal ' Remove read-only attribute (if it came across) LoadDVB Replace(OldProject.FileName, OldProject.Name, "SelfCompact") Set NewProject = ThisDrawing.Application.VBE.VBProjects(ThisDrawing.Application.VBE.VBProjects.Count) ' Components For I% = 1 To OldProject.VBComponents.Count Set OldComponent = OldProject.VBComponents(I%) ComponentPath$ = Environ("UserProfile") & "\My Documents\" & OldComponent.Name & Switch(OldComponent.Type = 1, ".bas", OldComponent.Type = 2, ".cls", OldComponent.Type = 3, ".frm", OldComponent.Type = 100, ".doc", 1 = 1, "") OldComponent.Export ComponentPath$ If OldComponent.Name = "ThisDrawing" Then NewProject.VBComponents("ThisDrawing").CodeModule.AddFromFile ComponentPath$ NewProject.VBComponents("ThisDrawing").CodeModule.DeleteLines 1, 4 ' Class-specific stuff we don't want Else NewProject.VBComponents.Import ComponentPath$ End If Next I% ' References For I% = NewProject.References.Count + 1 To OldProject.References.Count NewProject.References.AddFromFile OldProject.References(I%).FullPath Next I% ' Tidy up NewProject.Name = OldProject.Name NewProject.VBComponents("ThisDrawing").Activate NewProject.VBComponents("ThisDrawing").CodeModule.CodePane.Show I% = NewProject.VBComponents("ThisDrawing").CodeModule.ProcStartLine("SelfCompactPartTwo", 0) + 1 ' Slackly using I% to store first line of PartTwo procedure NewProject.VBComponents("ThisDrawing").CodeModule.CodePane.SetSelection I%, 1, I%, 1 SendKeys "{F5}", False End Sub Private Sub SelfCompactPartTwo() Dim ProjectPath$, NowString$, NewProject As Object, fso As New Scripting.FileSystemObject, I% If InStr(ThisDrawing.Application.VBE.ActiveVBProject.FileName, "SelfCompact.dvb") = 0 Then Stop ' Must only ever be invoked from SelfCompact Exit Sub End If SendKeys "^s", True ' Save SelfCompact.dvb ProjectPath$ = Replace(Replace(ThisDrawing.Application.VBE.ActiveVBProject.FileName, "SelfCompact", ThisDrawing.Application.VBE.ActiveVBProject.Name), "\\wpnt2\public", "P:") UnloadDVB ProjectPath$ NowString$ = Format$(Now, "yyyymmddhhnnss") Name ProjectPath$ As Left$(ProjectPath$, Len(ProjectPath$) - 4) & NowString$ & Right$(ProjectPath$, 4) fso.CopyFile ThisDrawing.Application.VBE.ActiveVBProject.FileName, ProjectPath$, False LoadDVB ProjectPath$ Set NewProject = ThisDrawing.Application.VBE.VBProjects(ThisDrawing.Application.VBE.VBProjects.Count) NewProject.VBComponents("ThisDrawing").Activate NewProject.VBComponents("ThisDrawing").CodeModule.CodePane.Show I% = NewProject.VBComponents("ThisDrawing").CodeModule.ProcStartLine("SelfCompactPartThree", 0) + 1 ' Slackly using I% to store first line of PartThree procedure NewProject.VBComponents("ThisDrawing").CodeModule.CodePane.SetSelection I%, 1, I%, 1 SendKeys "{F5}", False End Sub Private Sub SelfCompactPartThree() If ThisDrawing.Application.VBE.VBProjects.Count = 1 Then Stop ' Must only ever be invoked from SelfCompact Exit Sub End If UnloadDVB Replace(Replace(ThisDrawing.Application.VBE.ActiveVBProject.FileName, ThisDrawing.Application.VBE.ActiveVBProject.Name, "SelfCompact"), "P:", "\\wpnt2\public") MsgBox Mid$(ThisDrawing.Application.VBE.ActiveVBProject.FileName, InStrRev(ThisDrawing.Application.VBE.ActiveVBProject.FileName, "\") + 1) & " is " & Round(FileLen(ThisDrawing.Application.VBE.ActiveVBProject.FileName) / 1024 ^ 2, 2) & "MB", vbInformation, "Project File has been compacted" End Sub [/pre] Regards Wayne Ivory IT Analyst Programmer Wespine Industries Pty Ltd
Yuck! Sorry that came out so wide. If you're looking for the Reply button it's waaaaaaaay over there on the right. Watch out - word wrap or something inserted a space right in the middle of the SelfCompactPartTwo and SelfCompactPartThree strings on both "Slackly" lines. Regards Wayne
(sigh) I've just seen a couple of other inserted spaces - some references to ".C ount". Keep an eye out - hopefully the compiler will pick up most of them. Regards Wayne
Wayne, just a comment about the problem you mentioned of a project running a macro on itself. You can do this eliminate a couple steps and avoid putting code in a temp dvb: Store the code in its own dvb, then from the ide's menu Tools>Macros, you can run a macro from another loaded dvb. Just select the dvb from the "Macros In" dropdown. For example, in my toolbox I have a module that, will add error handling to any procedure that the cursor is currently in. -- ---- Ed ---- Some time ago I wrote this three-part SelfCompact routine. Basically every time my project is getting too bloated I just place my cursor in the subroutine somewhere and hit the Play button and it exports itself and reimports itself and retains all the references. The nice thing is my new file is the same file I started with. "But you can't import over what you're currently running!" I hear you cry. Well, you're right, so the routine does a tricky hop-step-jump whereby it uses an intermediate copy of itself and runs some of the code from there, then when the original has been replaced it leaps back to it and tidies up the intermediate copy. Now I have thought about making it available on this forum for some time, but what held me back is that some of it is specific to my environment and there may be other things that people are doing with their projects that I haven't covered. I thought one day I'd make it more robust but I think I'm ready to admit to myself that probably won't happen, so I've decided to offer it here "as is". This is a pretty hairy topic so *please* make sure you have backups before you test this out. Once it's working in your environment though it should be fairly straightforward. I've been using it about a year now without incident. A couple of specifics to watch out for: 1. The 3 routines must reside inside the project itself. 2. It uses a file Empty.dvb that is (surprise!) a read-only clean empty dvb file. This must exist where the main project exists. 3. Part One attempts to determine where your My Documents directory is to place working files in. 4. Part One is making specific decisions about what file type and extensions to deal with. 5. My project lives on a mapped network drive P: but when the temporary copy is created the operating system substitutes the UNC (network) name back into the Path. The code needs the paths to be consistent so it does a replace on that part of the name. I had to hard-code these references to wpnt2 in Part Two and Part Three. If you're on a network you may need to use your own network information, otherwise you might be able to discard these parts altogether. 6. It uses the Microsoft Scripting Runtime library. [pre] Private Sub SelfCompact() ' By Wayne Ivory Dim I%, OldProject As Object, NewProject As Object, OldComponent As Object, ComponentPath$, fso As New Scripting.FileSystemObject Set OldProject = ThisDrawing.Application.VBE.ActiveVBProject If Not OldProject.Saved Then MsgBox "Can't compact while unsaved changes exist", vbExclamation, "SelfCompact" Exit Sub End If fso.CopyFile Replace(OldProject.FileName, OldProject.Name, "Empty"), Replace(OldProject.FileName, OldProject.Name, "SelfCompact"), True SetAttr Replace(OldProject.FileName, OldProject.Name, "SelfCompact"), vbNormal ' Remove read-only attribute (if it came across) LoadDVB Replace(OldProject.FileName, OldProject.Name, "SelfCompact") Set NewProject = ThisDrawing.Application.VBE.VBProjects(ThisDrawing.Application.VBE.VBProjects.Count) ' Components For I% = 1 To OldProject.VBComponents.Count Set OldComponent = OldProject.VBComponents(I%) ComponentPath$ = Environ("UserProfile") & "\My Documents\" & OldComponent.Name & Switch(OldComponent.Type = 1, ".bas", OldComponent.Type = 2, ".cls", OldComponent.Type = 3, ".frm", OldComponent.Type = 100, ".doc", 1 = 1, "") OldComponent.Export ComponentPath$ If OldComponent.Name = "ThisDrawing" Then NewProject.VBComponents("ThisDrawing").CodeModule.AddFromFile ComponentPath$ NewProject.VBComponents("ThisDrawing").CodeModule.DeleteLines 1, 4 ' Class-specific stuff we don't want Else NewProject.VBComponents.Import ComponentPath$ End If Next I% ' References For I% = NewProject.References.Count + 1 To OldProject.References.Count NewProject.References.AddFromFile OldProject.References(I%).FullPath Next I% ' Tidy up NewProject.Name = OldProject.Name NewProject.VBComponents("ThisDrawing").Activate NewProject.VBComponents("ThisDrawing").CodeModule.CodePane.Show I% = NewProject.VBComponents("ThisDrawing").CodeModule.ProcStartLine("SelfCompactPartTwo", 0) + 1 ' Slackly using I% to store first line of PartTwo procedure NewProject.VBComponents("ThisDrawing").CodeModule.CodePane.SetSelection I%, 1, I%, 1 SendKeys "{F5}", False End Sub Private Sub SelfCompactPartTwo() Dim ProjectPath$, NowString$, NewProject As Object, fso As New Scripting.FileSystemObject, I% If InStr(ThisDrawing.Application.VBE.ActiveVBProject.FileName, "SelfCompact.dvb") = 0 Then Stop ' Must only ever be invoked from SelfCompact Exit Sub End If SendKeys "^s", True ' Save SelfCompact.dvb ProjectPath$ = Replace(Replace(ThisDrawing.Application.VBE.ActiveVBProject.FileName, "SelfCompact", ThisDrawing.Application.VBE.ActiveVBProject.Name), "\\wpnt2\public", "P:") UnloadDVB ProjectPath$ NowString$ = Format$(Now, "yyyymmddhhnnss") Name ProjectPath$ As Left$(ProjectPath$, Len(ProjectPath$) - 4) & NowString$ & Right$(ProjectPath$, 4) fso.CopyFile ThisDrawing.Application.VBE.ActiveVBProject.FileName, ProjectPath$, False LoadDVB ProjectPath$ Set NewProject = ThisDrawing.Application.VBE.VBProjects(ThisDrawing.Application.VBE.VBProjects.Count) NewProject.VBComponents("ThisDrawing").Activate NewProject.VBComponents("ThisDrawing").CodeModule.CodePane.Show I% = NewProject.VBComponents("ThisDrawing").CodeModule.ProcStartLine("SelfCompactPartThree", 0) + 1 ' Slackly using I% to store first line of PartThree procedure NewProject.VBComponents("ThisDrawing").CodeModule.CodePane.SetSelection I%, 1, I%, 1 SendKeys "{F5}", False End Sub Private Sub SelfCompactPartThree() If ThisDrawing.Application.VBE.VBProjects.Count = 1 Then Stop ' Must only ever be invoked from SelfCompact Exit Sub End If UnloadDVB Replace(Replace(ThisDrawing.Application.VBE.ActiveVBProject.FileName, ThisDrawing.Application.VBE.ActiveVBProject.Name, "SelfCompact"), "P:", "\\wpnt2\public") MsgBox Mid$(ThisDrawing.Application.VBE.ActiveVBProject.FileName, InStrRev(ThisDrawing.Application.VBE.ActiveVBProject.FileName, "\") + 1) & " is " & Round(FileLen(ThisDrawing.Application.VBE.ActiveVBProject.FileName) / 1024 ^ 2, 2) & "MB", vbInformation, "Project File has been compacted" End Sub [/pre] Regards Wayne Ivory IT Analyst Programmer Wespine Industries Pty Ltd
