B
Brettjg
I want to copy all the modules from my PERSONAL.XLS to another workbook on a
regular basis because too regularly PERSONAL jumps in size from 900kb to over
2mb for no apparent reason. Using the following code from Chip Pearson (which
I have stumbled my way through some modifications). One of two things happens:
1. If I compile the code exactly as shown here I get a "ByRef argument type
mismatch" in the Call line on ModuleName_out. I guess this is because I have
declared it as VBIDE.VBComponent in the sub but as String (as Chip says) in
the function.
CODE:
Option Explicit
Public Enum ProcScope
ScopePrivate = 1
ScopePublic = 2
ScopeFriend = 3
ScopeDefault = 4
End Enum
Public Enum LineSplits
LineSplitRemove = 0
LineSplitKeep = 1
LineSplitConvert = 2
End Enum
Public Type ProcInfo
ProcName As String
ProcKind As VBIDE.vbext_ProcKind
ProcStartLine As Long
ProcBodyLine As Long
ProcCountLines As Long
ProcScope As ProcScope
ProcDeclaration As String
End Type
Sub a_PERSONAL_BACKUP()
Dim ModuleName_out As VBIDE.VBComponent
Dim FromVBProject_out As VBIDE.VBProject
Dim ToVBProject_out As VBIDE.VBProject
Dim OverwriteExisting_out As Boolean
Dim VBProj As VBIDE.VBProject
Set FromVBProject_out = Application.ActiveWorkbook.VBProject
Set ToVBProject_out = Application.Workbooks("PERSONAL
BACKUP.xls").VBProject
Set VBProj = Application.Workbooks("PERSONAL.XLS").VBProject
Set ModuleName_out = VBProj.VBComponents("aa_GENERAL_USE")
Call CopyModule(ModuleName_out, FromVBProject_out, ToVBProject_out,
OverwriteExisting_out)
End Sub
Function CopyModule(ModuleName As String, FromVBProject As VBIDE.VBProject,
ToVBProject As VBIDE.VBProject, OverwriteExisting As Boolean) As Boolean
Dim VBComp As VBIDE.VBComponent
Dim FName As String
' Do some housekeeping validation.
If FromVBProject Is Nothing Then
CopyModule = False
Exit Function
End If
If Trim(ModuleName) = vbNullString Then
CopyModule = False
Exit Function
End If
If ToVBProject Is Nothing Then
CopyModule = False
Exit Function
End If
If FromVBProject.Protection = vbext_pp_locked Then
CopyModule = False
Exit Function
End If
If ToVBProject.Protection = vbext_pp_locked Then
CopyModule = False
Exit Function
End If
On Error Resume Next
Set VBComp = FromVBProject.VBComponents(ModuleName)
If Err.Number <> 0 Then
CopyModule = False
Exit Function
End If
' FName is the name of the temporary file to be used in the
Export/Import code.
FName = Environ("Temp") & "\" & ModuleName & ".bas"
If OverwriteExisting = True Then
' If OverwriteExisting is True, Kill the existing temp file and
remove the existing VBComponent from the ToVBProject.
If Dir(FName, vbNormal + vbHidden + vbSystem) <> vbNullString Then
Err.Clear
Kill FName
If Err.Number <> 0 Then
CopyModule = False
Exit Function
End If
End If
With ToVBProject.VBComponents
.Remove .Item(ModuleName)
End With
Else
' OverwriteExisting is False. If there is already a VBComponent
named ModuleName, exit with a return code of False.
Err.Clear
Set VBComp = ToVBProject.VBComponents(ModuleName)
If Err.Number <> 0 Then
If Err.Number = 9 Then
' module doesn't exist. ignore error.
Else
' other error. get out with return value of False
CopyModule = False
Exit Function
End If
End If
End If
' Do the Export and Import operation using FName and then Kill FName.
FromVBProject.VBComponents(ModuleName).Export Filename:=FName
ToVBProject.VBComponents.Import Filename:=FName
Kill FName
CopyModule = True
End Function
2. If I change the code in the function to declare ModuleName_out as
VBIDE.VBComponent it will then compile but the function debugs on the If
Trim(Modulename) with "Object doesn't support this method" (coz it ain't a
string I guess)
Chip, you're doing my head in! Please help.
Regards Brett Gregory
regular basis because too regularly PERSONAL jumps in size from 900kb to over
2mb for no apparent reason. Using the following code from Chip Pearson (which
I have stumbled my way through some modifications). One of two things happens:
1. If I compile the code exactly as shown here I get a "ByRef argument type
mismatch" in the Call line on ModuleName_out. I guess this is because I have
declared it as VBIDE.VBComponent in the sub but as String (as Chip says) in
the function.
CODE:
Option Explicit
Public Enum ProcScope
ScopePrivate = 1
ScopePublic = 2
ScopeFriend = 3
ScopeDefault = 4
End Enum
Public Enum LineSplits
LineSplitRemove = 0
LineSplitKeep = 1
LineSplitConvert = 2
End Enum
Public Type ProcInfo
ProcName As String
ProcKind As VBIDE.vbext_ProcKind
ProcStartLine As Long
ProcBodyLine As Long
ProcCountLines As Long
ProcScope As ProcScope
ProcDeclaration As String
End Type
Sub a_PERSONAL_BACKUP()
Dim ModuleName_out As VBIDE.VBComponent
Dim FromVBProject_out As VBIDE.VBProject
Dim ToVBProject_out As VBIDE.VBProject
Dim OverwriteExisting_out As Boolean
Dim VBProj As VBIDE.VBProject
Set FromVBProject_out = Application.ActiveWorkbook.VBProject
Set ToVBProject_out = Application.Workbooks("PERSONAL
BACKUP.xls").VBProject
Set VBProj = Application.Workbooks("PERSONAL.XLS").VBProject
Set ModuleName_out = VBProj.VBComponents("aa_GENERAL_USE")
Call CopyModule(ModuleName_out, FromVBProject_out, ToVBProject_out,
OverwriteExisting_out)
End Sub
Function CopyModule(ModuleName As String, FromVBProject As VBIDE.VBProject,
ToVBProject As VBIDE.VBProject, OverwriteExisting As Boolean) As Boolean
Dim VBComp As VBIDE.VBComponent
Dim FName As String
' Do some housekeeping validation.
If FromVBProject Is Nothing Then
CopyModule = False
Exit Function
End If
If Trim(ModuleName) = vbNullString Then
CopyModule = False
Exit Function
End If
If ToVBProject Is Nothing Then
CopyModule = False
Exit Function
End If
If FromVBProject.Protection = vbext_pp_locked Then
CopyModule = False
Exit Function
End If
If ToVBProject.Protection = vbext_pp_locked Then
CopyModule = False
Exit Function
End If
On Error Resume Next
Set VBComp = FromVBProject.VBComponents(ModuleName)
If Err.Number <> 0 Then
CopyModule = False
Exit Function
End If
' FName is the name of the temporary file to be used in the
Export/Import code.
FName = Environ("Temp") & "\" & ModuleName & ".bas"
If OverwriteExisting = True Then
' If OverwriteExisting is True, Kill the existing temp file and
remove the existing VBComponent from the ToVBProject.
If Dir(FName, vbNormal + vbHidden + vbSystem) <> vbNullString Then
Err.Clear
Kill FName
If Err.Number <> 0 Then
CopyModule = False
Exit Function
End If
End If
With ToVBProject.VBComponents
.Remove .Item(ModuleName)
End With
Else
' OverwriteExisting is False. If there is already a VBComponent
named ModuleName, exit with a return code of False.
Err.Clear
Set VBComp = ToVBProject.VBComponents(ModuleName)
If Err.Number <> 0 Then
If Err.Number = 9 Then
' module doesn't exist. ignore error.
Else
' other error. get out with return value of False
CopyModule = False
Exit Function
End If
End If
End If
' Do the Export and Import operation using FName and then Kill FName.
FromVBProject.VBComponents(ModuleName).Export Filename:=FName
ToVBProject.VBComponents.Import Filename:=FName
Kill FName
CopyModule = True
End Function
2. If I change the code in the function to declare ModuleName_out as
VBIDE.VBComponent it will then compile but the function debugs on the If
Trim(Modulename) with "Object doesn't support this method" (coz it ain't a
string I guess)
Chip, you're doing my head in! Please help.
Regards Brett Gregory