无法从VBA

时间:2017-11-06 08:30:57

标签: excel vba excel-vba ms-project

我在更新某些模块时遇到问题。在某些模块中,我可以删除并导入模块,但在其他模块中会发生的事情是先导入模块,然后删除原始模块,在模块名称的末尾添加1并弄乱代码。< / p>

以下是我的表现方式: 我有以下Excel文件,我可以跟踪谁需要或已更新到新模块版本。当我更新模块版本时,我只需输入正确的用户名栏Not Updated。用户打开其MS Project后,将运行以下代码并将值更改为Updatedenter image description here

然后我在VBA - Project Project 2016上的Project.Activate上运行以下命令来检查模块是否需要更新。

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 个答案:

答案 0 :(得分:0)

在调用DoEvents方法后添加Remove,以便为Remove方法完成时间。

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

如果Remove方法失败,可能会发生错误,但On Error Resume Next行隐藏了错误。注释掉On Error...行并查看错误是什么并处理它而不是忽略它。