Autosave addin for VBA IDE

Stand alone Visual Basic has an option to automatically save your project
each time you run code in the IDE
This has resulted in me developing some poor habits.

As VBA does not have this facility I am getting caught out when AutoCAD
falls over and I haven't saved my code.
Whist I am trying to train my self to hit SAVE at regular intervals does
anyone know of a VBA addin that will save my code before running it.

--
Regards
Tom Roberts
__________________________
MechWest Design & Drafting
Perth, Western Australia

 

Some time ago Wayne Ivory posted this method
perhaps you can adapt it to your needs
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.VBProject
s.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("SelfCompact
PartTwo", 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.VBProject
s.Count)
NewProject.VBComponents("ThisDrawing").Activate
NewProject.VBComponents("ThisDrawing").CodeModule.CodePane.Show
I% =
NewProject.VBComponents("ThisDrawing").CodeModule.ProcStartLine("SelfCompact
PartThree", 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
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

---response from ed jobe
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
----

also posted here....
'from Juerg Menzi
'I use a modified version from Kevin Terry's function (posted 10/15/2002):

'---------------------------------------------------------------------------
--
' Exports all modules, classes and forms from project into a subdirectory
with
' the name of the current version of project and current date.
' References:
' - Microsoft Visual Basic for Applications Extensibility
' - Microsoft Scripting Runtime
'
Public Sub ProjectRevisionBackup()

Dim vApp As VBIDE.VBE
Dim vProj As VBProject
Dim vComp As VBComponent
Dim sPath As String
Dim sProjPath As String
Dim PrjNme As String
Dim PrjVer As String
Dim sFile As String
Dim sProj As String
Dim sCode As String
Dim asFiles() As String
Dim i As Integer
Dim FilObj As FileSystemObject
Dim DatObj As File

Set vApp = Application.VBE
Set FilObj = CreateObject("Scripting.FileSystemObject")
PrjNme = "MyProject" 'Set to project name
PrjVer = "1.01.03" 'Set to project version

For i = 1 To vApp.VBProjects.Count
If UCase(vApp.VBProjects(i).Name) = UCase(PrjNme) Then
Set vProj = vApp.VBProjects.Item(i)
sPath = vProj.BuildFileName
sFile = FilObj.GetBaseName(sPath)
sProj = sFile & ".dvb"
sPath = FilObj.GetParentFolderName(sPath)
End If
Next i

'build path for version
sProjPath = sPath
' sPath = sPath & "\Dev\VBA-v" & PrjVer & "-" & Format(Date,"mm-dd-yyyy")
'Oops, typo...

'sPath = sPath & "\Dev\VBA-v" & PrjVer & "-" & Format(Date,"mm-dd-yyyy")
'must be:
sPath = sPath & "\Dev\VBA-v" & PrjVer & "-" & Format(Date, "mm-dd-yyyy") &
"\"

'raise error for no path
On Error Resume Next
ChDir (sPath)
'make directory
If Err.Number = 76 Then MkDir (sPath)
Err.Clear
On Error GoTo 0

'copy project file
Set DatObj = FilObj.GetFile(sProjPath & "\" & sFile & ".dvb")
DatObj.Copy sPath, True

'export all components
For i = 1 To vProj.VBComponents.Count
Set vComp = vProj.VBComponents.Item(i)
sFile = vComp.Name
'test for type:
Select Case vComp.Type
Case vbext_ct_MSForm
vComp.Export sPath & sFile & ".frm"
Case vbext_ct_ClassModule
vComp.Export sPath & sFile & ".cls"
Case vbext_ct_StdModule
vComp.Export sPath & sFile & ".bas"
Case vbext_ct_Document
vComp.Export sPath & sFile & ".cls"
Case Else
'do nothing
End Select
Next

MsgBox "Remember to manually compress the project file.", vbOKOnly, _
PrjNme & " " & PrjVer

Set vApp = Nothing
Set vProj = Nothing
Set vComp = Nothing
Set FilObj = Nothing
Set DatObj = Nothing

End Sub
'---------------------------------------------------------------------------
--

'Cheers
'--
'Juerg Menzi
'MENZI ENGINEERING GmbH, Switzerland
'http://www.menziengineering.ch

 

Thanks, looks interesting...
However I am after a "no-user-input" approach.

i.e. After hitting RUN [F5] my project is automatically saved before any
code is executed
I imagine it would have to be a properly constructed and register add-in
that will by triggered by a VBA IDE event
Not simply another project that is open.

--
Regards
Tom Roberts
__________________________
MechWest Design & Drafting
Perth, Western Australia

 

Hi Tom,
I figured that's what you were after.
Since you said you also work in vb I thought you could use the code concepts
shown to make your own add in.
Hope you find a solution. I'd be interested to hear how you handled it.

Mark

 

Tom,

I got unexpectedly sidelined onto another project for a month or so and am only now just getting back to my "Cad" project and consequently catching up on all the posts.

I do what you're looking for by adding the following line into the beginning of my project, as well as the subsequent routine.

Code:

If Not ThisDrawing.Application.VBE.ActiveVBProject.Saved Then LocalBackup

Private Sub LocalBackup()
Dim I%, NowString$, ProjectPart As Object

NowString$ = Format$(Now, "yyyymmddhhnnss")
For I% = 1 To ThisDrawing.Application.VBE.ActiveVBProject.VBComponents.Count
Set ProjectPart = ThisDrawing.Application.VBE.ActiveVBProject.VBComponents(I%)
ProjectPart.Export Environ("UserProfile") & "\My Documents\" & ProjectPart.Name & NowString$ & Switch(ProjectPart.Type = 1, ".bas", ProjectPart.Type = 2, ".cls", ProjectPart.Type = 3, ".frm", ProjectPart.Type = 100, ".cls", 1 = 1, "")
Next I%
End Sub

Regards

Wayne Ivory
IT Analyst Programmer
Wespine Industries Pty Ltd
(Also Western Australia!!)

 

Wayne

Perfect...
Not what I was thinking of when I first posted, but will do the job very
nicely.
And you managed to use on one line two functions I was not aware of
ENVIRON and SWITCH. And to think all this time I have been using the win API
to get the temp folder

I had noticed your tag and figured it was probably the Wespine I know off.
Are you based in Welshpool. We are in Mount Hawthorn NOR
Be sure to give us a ring if your drawing office get overloaded and needs to
farm some work out ;-)
Thanks very much for your assistance.

--
Regards
Tom Roberts
__________________________
MechWest Design & Drafting
Perth, Western Australia

only now just getting back to my "Cad" project and consequently catching up
on all the posts.

beginning of my project, as well as the subsequent routine.

 

Glad to help.

I'm not in the Welshpool office, I'm at the mill in Dardanup where the "real" work is done! ;-)

Regards

Wayne