1
votes

I have a problem updating certain modules. In some modules I can delete and import the modules, but on others what happens is that the module is imported first and the original deleted later which adds a 1 at the end of the module name and messes up the code.

Here's how I do it: I have the following Excel file which I can track who needs or has updated to the new module version. When I update the module version I just type on the correct username column Not Updated. Once the user opens his MS Project it runs the following code and changes the value to Updated. enter image description here

Then I run the following on Project.Activate in VBA - MS Project 2016 to check if the module needs to update.

Dim xlapp As Object
Dim xlbook As Object
Dim sHostName As String
Dim modulesList_loc As String
Dim projectVBA_loc As String
Dim modulesVBA_loc As String

projectVBA_loc = "\\sharedNetwork\Project\VBA\"
modulesVBA_loc = projectVBA_loc & "Modules\"
modulesList_loc = projectVBA_loc & "Modules Updates.xlsx"

' Get Host Name / Get Computer Name
sHostName = Environ$("username")

Set xlapp = CreateObject("Excel.Application")
SetAttr modulesList_loc, vbNormal
Set xlbook = xlapp.Workbooks.Open(modulesList_loc)


Dim rng_modules As Range
Dim rng_usernames As Range
Dim username As Range
Dim atualizado As Range
Dim module_name As Range
Dim lastcol As Long
Dim lastcol_letter As String
Dim linha As Integer
Dim len1 As Integer
Dim len2 As Integer
Dim module_name_short As String
Dim actualizar As Integer

'LAST USERNAME COLUMN
With xlbook.Worksheets(1)
    'Last Column
    lastcol = .Cells(2, .Columns.Count).End(xlToLeft).Column
    lastcol_letter = GetColumnLetter(lastcol, xlbook.Worksheets(1))
End With

'Usernames range
Set rng_usernames = xlbook.Worksheets(1).Range("E2:" & lastcol_letter & "2")
'Finds the correct username
Set username = rng_usernames.Find(sHostName)

Set rng_modules = xlbook.Worksheets(1).Range("A3")  'First module
Do While rng_modules.Value <> Empty
    'Adds module if necessary
    linha = rng_modules.Row
    Set atualizado = username.Offset(linha - 2)
    Set module_name = rng_modules.Offset(, 1)
    If atualizado.Value = "Not Updated" Then
        With ThisProject.VBProject
            len1 = Len(module_name.Value)
            len2 = len1 - 4
            module_name_short = Left(module_name.Value, len2)
            On Error Resume Next
            .VBComponents.Remove .VBComponents(module_name_short)
            .VBComponents.import modulesVBA_loc & module_name.Value
        End With
        atualizado.Value = "Updated"
    End If
    Set rng_modules = rng_modules.Offset(1)
Loop

xlbook.Close (True)
SetAttr modulesList_loc, vbReadOnly
1

1 Answers

0
votes

Add DoEvents after the Remove method is called to give time for the Remove method to complete.

'On Error Resume Next
.VBComponents.Remove .VBComponents(module_name_short)
DoEvents
.VBComponents.import modulesVBA_loc & module_name.Value

If the Remove method is failing, there is likely an error occurring, but the On Error Resume Next line is hiding the error. Comment out the On Error... line and see what the error is and handle it rather than ignore it.