Doc
"Jade Jacobsen" <jjac...@mscon.com> wrote in message
news:CD0697C1B7717383...@in.WebX.maYIadrTaRb...
dvb's can occaisionally become corrupt. Once that happens you are SOL and
just have to hope that you've backed it up recently. When I've had problems
it's always been after doing form layout/creation work.
Before backing up the dvb file it's good to see if you can reopen it first,
otherwise you could overwrite a good backup with a corrupt file.
Another thing you can do is export the individual components (forms,
modules, classes) from the dvb. I created a macro to automate this process.
It creates a folder with the data/time with all of the exported components.
Look for a thread called "VBA project file size bloat!" from march 19/20
Glen
"Jade Jacobsen" <jjac...@mscon.com> wrote in message
news:162E622E089A2A74...@in.WebX.maYIadrTaRb...
Thanks for your replies. I have a renewed faith in the NG's. I am very new
to programming, and the best help I have received has come from here. Just
seems like I haven't been able to get a response the last few times I wrote.
Thanks again,
Jade
"Glen Albert" <glen....@autodesk.com> wrote in message
news:0AA9B744193150CB...@in.WebX.maYIadrTaRb...
I just tried your export routine. LOVE IT!
Thanks,
Jade
"Jade Jacobsen" <jjac...@mscon.com> wrote in message
news:CD0697C1B7717383...@in.WebX.maYIadrTaRb...
Glen
"Jade Jacobsen" <jjac...@mscon.com> wrote in message
news:01C79F26C2C58DD5...@in.WebX.maYIadrTaRb...
I tried to take your idea to the next phase. I got stuck at saving the completed .dvb
file. The following will get you about 90% there, though. You just have to go into VBA
Manager and saveas the newly created .dvb over the original file.
In order for the following to work you will have to do two things first.
1. Create an empty .dvb file, and put it in the folder where you keep all your other
.dvb files.
2. Download Frank Oquendo's CommonDialog.cls from AcadX, and import the class file into
the module where you place the following code.
Option Explicit
Option Compare Text
Sub UnBloat()
Dim ComDlg As New CommonDialog
Dim strVBAfolder as String
Dim Files() As Variant
'Plug in the path to the folder where you keep your .dvb's below.
strVBAfolder = "T:\Acad2000\VBA"
With ComDlg
.DialogTitle = "Select files"
.DefaultExt = "dvb"
.Filter = "VBA Projects (*.dvb)|*.dvb"
.Flags = OFN_EXPLORER Or OFN_ALLOWMULTISELECT Or OFN_HIDEREADONLY
.InitDir = strVBAfolder
If .ShowOpen Then
Files = .ParseFileNames
Else
GoTo NoFilesSelected
End If
End With
Dim objIDE As Object
Dim iCNT1 As Integer
Dim iCNT2 As Integer
Dim strFileName As String
Dim strBuildFile As String
Dim ProjLoaded
Dim objProj As Variant
Dim strFldrName As String
Dim strProjName As String
Dim objFileSys As Object
Dim objComp As Variant
Dim strFileExt As String
Dim strComponents() As String
Dim objRef As Variant
Dim strReferences() As String
Dim strTmpDVBfile As String
Dim objBlankProj As Object
Dim RefExists As Boolean
Set objIDE = Application.VBE
For iCNT1 = LBound(Files) To UBound(Files)
strFileName = Files(iCNT1)
ProjLoaded = False
strProjName = FindProject(strFileName)
If strProjName <> "" Then
Set objProj = objIDE.vbprojects.Item(strProjName)
ProjLoaded = True
End If
If ProjLoaded = False Then
LoadDVB strFileName
Set objProj = objIDE.vbprojects.Item(FindProject(strFileName))
End If
strFldrName = Replace(strFileName, ".DVB", "")
strProjName = objProj.Name
Set objFileSys = CreateObject("Scripting.FileSystemObject")
objFileSys.createfolder strFldrName
iCNT2 = 0
For Each objComp In objProj.vbcomponents
If objComp.Type <> 100 Then
ReDim Preserve strComponents(iCNT2)
Select Case objComp.Type
Case 1
strFileExt = ".bas"
Case 2
strFileExt = ".cls"
Case 3
strFileExt = ".frm"
End Select
strComponents(iCNT2) = strFldrName & "\" & objComp.Name & strFileExt
objComp.Export strComponents(iCNT2)
iCNT2 = iCNT2 + 1
End If
Next
iCNT2 = 0
For Each objRef In objProj.references
ReDim Preserve strReferences(iCNT2)
strReferences(iCNT2) = objRef.fullpath
iCNT2 = iCNT2 + 1
Next
UnloadDVB strFileName
strTmpDVBfile = strVBAfolder & "\Template.dvb"
LoadDVB strTmpDVBfile
'The following line didn't work so I had to resort to using a template .dvb file.
' Set objBlankProj = objIDE.vbprojects.Add(100)
Set objBlankProj = objIDE.vbprojects(objIDE.vbprojects.Count)
objBlankProj.Name = strProjName
For iCNT2 = LBound(strComponents) To UBound(strComponents)
objBlankProj.vbcomponents.Import (strComponents(iCNT2))
Next iCNT2
If iCNT2 = UBound(strComponents) + 1 Then
MsgBox "All components were imported successfully."
Else
MsgBox "Unable to import " & UBound(strComponents) + 1 - iCNT2 & "
components."
End If
objFileSys.deletefolder strFldrName
For iCNT2 = LBound(strReferences) To UBound(strReferences)
RefExists = False
For Each objRef In objBlankProj.references
If objRef.fullpath = strReferences(iCNT2) Then
RefExists = True
Exit For
End If
Next
If RefExists = False Then objBlankProj.references.addfromfile
strReferences(iCNT2)
Next iCNT2
If iCNT2 = UBound(strReferences) + 1 Then
MsgBox "All references were restored successfully."
Else
MsgBox "Unable to restore " & UBound(strComponents) + 1 - iCNT2 & "
references."
End If
MsgBox "Project: " & objBlankProj.Name & " was successfully restored."
UnloadDVB strTmpDVBfile
'The following line doesn't work in VBA.
' objBlankProj.SaveAs strFileName
' If ProjLoaded = False Then UnloadDVB strFileName
Next iCNT1
Set objIDE = Nothing
Set objProj = Nothing
Set objFileSys = Nothing
Set objComp = Nothing
Set objRef = Nothing
Set objBlankProj = Nothing
NoFilesSelected:
Set ComDlg = Nothing
End Sub
Function FindProject(ByVal strFileName As String) As String
Dim objIDE As Object
Dim objProj As Variant
Dim strBuildFile As String
FindProject = ""
Set objIDE = Application.VBE
For Each objProj In objIDE.vbprojects
strBuildFile = UCase(objProj.FileName)
'The next two lines are in place to work around the fact that the project's FileName
property
'was returning a UNC name instead of a drive letter.
strBuildFile = Replace(strBuildFile, "\\FILESERVER\PROJECTS", "T:")
strBuildFile = Replace(strBuildFile, "\\FILESERVER\CHUCK$", "Z:")
strFileName = UCase(strFileName)
If strBuildFile = strFileName Then
FindProject = objProj.Name
Exit For
End If
Next
Set objIDE = Nothing
Set objProj = Nothing
End Function
Enjoy.
P.S. - Please let me know if you have any problems with this code. I modified it slightly
for this post to make it more generic.
Chuck Gabriel
"Glen Albert" <glen....@autodesk.com> wrote in message
news:65835CA952511684...@in.WebX.maYIadrTaRb...
Glen
"Chuck Gabriel" <BOT_VICT...@bellsouth.net> wrote in message
news:0F86B8A9A6C1FFF6...@in.WebX.maYIadrTaRb...