<tbody>
[TD="class: votecell"][/TD]
[TD="class: postcell"]I have built an extensive program for my organization which periodically needs to be updated.
I have tried having a macro that deletes all the old macros except itself and then reimports from a central repository but I run into a naming problem.
Source code below. I have reference location in the excel worksheet that it pulls from opens the reference workbook. The macro deletes the old macro and then imports the new. The problem is that even though the old macro has been deleted it still names the file with a two. How do I get it to reset back to the original name.
My go to source has been http://www.cpearson.com/Excel/Topic.aspx http://what-when-how.com/excel-vba/creating-excel-add-ins/
Code:
Sub SystemUpdate()
'Defining Variables
Dim ws As Worksheet, PReference As String
Dim strPath As String
Dim Source As Workbook
Dim Target As Workbook
Dim VersionSource As Long
Dim VersionTarget As Long
Dim VBProj As VBIDE.VBProject
Dim VBComp As VBIDE.VBComponent
Dim CodeMod As VBIDE.CodeModule
Dim EVMBook As String
'Resets Clipboard to ensure memory space
Dim clipboard As MSForms.DataObject
Set clipboard = New MSForms.DataObject
clipboard.Clear
'Checks if the Auto Update Function is On
If MainMenu.OnButton = True Then
Application.DisplayAlerts = False
'System Check for Updates
'PReference = MainMenu.Range("D34").Value
EVM = ActiveWorkbook.Name
Set Target = Workbooks(EVM)
VersionTarget = Workbooks(EVM).Worksheets("Main Menu").Range("Y4").Value
Workbooks(EVM).Worksheets("Main Menu").Range("D36").Value = ActiveWorkbook.Path & "\" & ActiveWorkbook.Name
Targetloc = MainMenu.Range("D36").Value
Call Z_UpdateStorage.SourcePath(1)
Call Z_UpdateStorage.SourcePath(2)
'Section 2 Opens Reference File
'MsgBox ("X:\projects\Program_Control\Macros\Program Overview Master Files\" & PReference)
'Workbooks.Open Filename:=MainMenu.Range("D34").Value
Reference = MainMenu.Range("D34").Value
Set Source = Workbooks.Open(Reference)
Reference = ActiveWorkbook.Name
VersionSource = Workbooks(Reference).Worksheets("Main Menu").Range("Y4").Value
If VersionSource > VersionTarget Then
Call ModuleDelete(Target)
'Reimport Modules
'A_ImportModule
Const strTextFile = "A_ImportModule.bas"
strPath = Environ("Temp")
If Right(strPath, 1) <> "\" Then
strPath = strPath & "\"
End If
Source.VBProject.VBComponents("A_ImportModule").Export strPath & strTextFile
Target.VBProject.VBComponents.Import strPath & strTextFile
Kill strPath & strTextFile
'DataValidation
Const strTextFile1 = "DataValidation.bas"
strPath = Environ("Temp")
If Right(strPath, 1) <> "\" Then
strPath = strPath & "\"
End If
Source.VBProject.VBComponents("DataValidation").Export strPath & strTextFile1
Target.VBProject.VBComponents.Import strPath & strTextFile1
Kill strPath & strTextFile1
'ETCSpreads
Const strTextFile2 = "ETCSpreads.bas"
strPath = Environ("Temp")
If Right(strPath, 1) <> "\" Then
strPath = strPath & "\"
End If
Source.VBProject.VBComponents("ETCSpreads").Export strPath & strTextFile2
Target.VBProject.VBComponents.Import strPath & strTextFile2
Kill strPath & strTextFile2
'ExportModule
Const strTextFile3 = "ExportModule.bas"
strPath = Environ("Temp")
If Right(strPath, 1) <> "\" Then
strPath = strPath & "\"
End If
Source.VBProject.VBComponents("ExportModule").Export strPath & strTextFile3
Target.VBProject.VBComponents.Import strPath & strTextFile3
Kill strPath & strTextFile3
'Format
Const strTextFile4 = "Formating.bas"
strPath = Environ("Temp")
If Right(strPath, 1) <> "\" Then
strPath = strPath & "\"
End If
Source.VBProject.VBComponents("Format").Export strPath & strTextFile4
Target.VBProject.VBComponents.Import strPath & strTextFile4
Kill strPath & strTextFile4
'HeadCount
Const strTextFile5 = "HeadCount.bas"
strPath = Environ("Temp")
If Right(strPath, 1) <> "\" Then
strPath = strPath & "\"
End If
Source.VBProject.VBComponents("HeadCount").Export strPath & strTextFile5
Target.VBProject.VBComponents.Import strPath & strTextFile5
Kill strPath & strTextFile5
'LaborData
Const strTextFile6 = "LaborData.bas"
strPath = Environ("Temp")
If Right(strPath, 1) <> "\" Then
strPath = strPath & "\"
End If
Source.VBProject.VBComponents("LaborData").Export strPath & strTextFile6
Target.VBProject.VBComponents.Import strPath & strTextFile6
Kill strPath & strTextFile6
'Report
Const strTextFile8 = "Report.bas"
strPath = Environ("Temp")
If Right(strPath, 1) <> "\" Then
strPath = strPath & "\"
End If
Source.VBProject.VBComponents("Report").Export strPath & strTextFile8
Target.VBProject.VBComponents.Import strPath & strTextFile8
Kill strPath & strTextFile8
'Stoplight
Const strTextFile9 = "Stoplight.bas"
strPath = Environ("Temp")
If Right(strPath, 1) <> "\" Then
strPath = strPath & "\"
End If
Source.VBProject.VBComponents("Stoplight").Export strPath & strTextFile9
Target.VBProject.VBComponents.Import strPath & strTextFile9
Kill strPath & strTextFile9
' TPRs
Const strTextFile10 = "TPRs.bas"
strPath = Environ("Temp")
If Right(strPath, 1) <> "\" Then
strPath = strPath & "\"
End If
Source.VBProject.VBComponents("TPRs").Export strPath & strTextFile10
Target.VBProject.VBComponents.Import strPath & strTextFile10
Kill strPath & strTextFile10
'X_ReferenceInfo
Const strTextFile11 = "X_ReferenceInfo.bas"
strPath = Environ("Temp")
If Right(strPath, 1) <> "\" Then
strPath = strPath & "\"
End If
Source.VBProject.VBComponents("X_ReferenceInfo").Export strPath & strTextFile11
Target.VBProject.VBComponents.Import strPath & strTextFile11
Kill strPath & strTextFile11
'X_SystemUpdate
Const strTextFile12 = "X_SystemUpdate.bas"
strPath = Environ("Temp")
If Right(strPath, 1) <> "\" Then
strPath = strPath & "\"
End If
Source.VBProject.VBComponents("X_SystemUpdate").Export strPath & strTextFile12
Target.VBProject.VBComponents.Import strPath & strTextFile12
Kill strPath & strTextFile12
'Program List
Windows(Reference).Activate
Sheets("Programs").Select
Cells.Select
Selection.Copy
Windows(EVM).Activate
Sheets("Programs").Select
Range("A1").Select
Sheets("Programs").Paste
Application.CutCopyMode = False
Windows(Reference).Activate
'Calendar List
Windows(Reference).Activate
Sheets("Net Month Hrs").Select
Cells.Select
Selection.Copy
Windows(EVM).Activate
Sheets("Net Month Hrs").Select
Range("A1").Select
Sheets("Net Month Hrs").Paste
Application.CutCopyMode = False
Sheets("Net Month Hrs").Select
Range("X2").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(MONTH('Main Menu'!R[6]C[-12]),'Net Month Hrs'!RC[-5]:R[11]C[-1],5)"
Range("X11").Select
ActiveCell.FormulaR1C1 = _
"=IF(MONTH('Main Menu'!R[-3]C[-12])<10,YEAR('Main Menu'!R[-3]C[-12])&0&MONTH('Main Menu'!R[-3]C[-12]),YEAR('Main Menu'!R[-3]C[-12])&MONTH('Main Menu'!R[-3]C[-12]))"
Sheets("Main Menu").Select
Range("L30").Select
ActiveCell.FormulaR1C1 = _
"=IF(R[-16]C-R[-16]C[-8]=R[-20]C,VLOOKUP(R[-16]C[-8]+R[-20]C,'Net Month Hrs'!R[-28]C[-2]:R[23]C[1],3,FALSE)+2,VLOOKUP(R[-16]C[-8]-1,'Net Month Hrs'!R[-28]C[-2]:R[23]C[1],3,FALSE)+2)"
Windows(Reference).Activate
Workbooks(EVM).Worksheets("Main Menu").Range("Y4").Value = VersionSource
Source.Close
Updated = True
Exit Sub
Else
Source.Close
Updated = False
Call MessageBoxTimer
End If
Application.DisplayAlerts = True
ElseIf MainMenu.OffButton = True Then
Ignore = MsgBox("The Following Updates will not be installed", vbOKCancel, "Ignore Auto Update")
NameUpdate = False
End If
End Sub
Sub PrepReferenceFile()
Application.DisplayAlerts = False
For Each wsa In Worksheets
If wsa.Name <> "Main Menu" And wsa.Name <> "User Directions" _
And wsa.Name <> "Programs" And wsa.Name <> "Net Month Hrs" _
And wsa.Name <> "Modules Definitions" And wsa.Name <> "RevisionLog" _
And wsa.Name <> "References" And wsa.Name <> "Modules" Then wsa.Delete
Next
Application.DisplayAlerts = True
End Sub
Sub Rename()
Set VBCodMod2 = ActiveWorkbook.VBProject.VBComponents("X_SystemUpdate1")
VBCodMod2.Name = "X_SystemUpdate"
Set VBCodMod2 = ActiveWorkbook.VBProject.VBComponents("a_ImportModule1")
VBCodMod2.Name = "a_ImportModule"
Set VBCodMod2 = ActiveWorkbook.VBProject.VBComponents("DataValidation1")
VBCodMod2.Name = "DataValidation"
Set VBCodMod2 = ActiveWorkbook.VBProject.VBComponents("X_ReferenceInfo1")
VBCodMod2.Name = "X_ReferenceInfo"
Set VBCodMod2 = ActiveWorkbook.VBProject.VBComponents("Report1")
VBCodMod2.Name = "Report"
End Sub
Sub MessageBoxTimer()
Dim AckTime As Integer, InfoBox As Object
Set InfoBox = CreateObject("WScript.Shell")
'Set the message box to close after 10 seconds
AckTime = 5
Select Case InfoBox.Popup("File is Up to Date", _
AckTime, "This is your Message Box", 0)
Case 1, -1
Exit Sub
End Select
End Sub
Sub ModuleDelete(Target As Workbook)
'A_ImportModule
With Target.VBProject.VBComponents
.Remove .Item("A_ImportModule")
End With
'DataValidation
With Target.VBProject.VBComponents
.Remove .Item("DataValidation")
End With
'ETCSpreads
With Target.VBProject.VBComponents
.Remove .Item("ETCSpreads")
End With
'ExportModule
With Target.VBProject.VBComponents
.Remove .Item("ExportModule")
End With
'Format
With Target.VBProject.VBComponents
.Remove .Item("Format")
End With
'HeadCount
With Target.VBProject.VBComponents
.Remove .Item("HeadCount")
End With
'LaborData
With Target.VBProject.VBComponents
.Remove .Item("LaborData")
End With
'Report
With Target.VBProject.VBComponents
.Remove .Item("Report")
End With
'Stoplight
With Target.VBProject.VBComponents
.Remove .Item("Stoplight")
End With
'TPRs
With Target.VBProject.VBComponents
.Remove .Item("TPRs")
End With
'X_ReferenceInfo
With Target.VBProject.VBComponents
.Remove .Item("X_ReferenceInfo")
End With
'X_SystemUpdate
With Target.VBProject.VBComponents
.Remove .Item("X_SystemUpdate")
End With
Exit Sub
End Sub
</tbody>