使用VBA刷新在Excel中对VBProject.VBComponents所做的更改

Cam*_*ilB 11 memory version-control excel vba flush

我一直在Excel中遇到一些奇怪的怪癖,同时以编程方式删除模块,然后从文件中重新导入它们.基本上,我有一个名为VersionControl的模块,它应该将我的文件导出到预定义的文件夹,并根据需要重新导入它们.这是重新导入的代码(下面介绍了它的问题):

Dim i As Integer
Dim ModuleName As String
Application.EnableEvents = False
With ThisWorkbook.VBProject
    For i = 1 To .VBComponents.Count
        If .VBComponents(i).CodeModule.CountOfLines > 0 Then
            ModuleName = .VBComponents(i).CodeModule.Name
            If ModuleName <> "VersionControl" Then
                If PathExists(VersionControlPath & "\" & ModuleName & ".bas") Then
                    Call .VBComponents.Remove(.VBComponents(ModuleName))
                    Call .VBComponents.Import(VersionControlPath & "\" & ModuleName & ".bas")
                Else
                    MsgBox VersionControlPath & "\" & ModuleName & ".bas" & " cannot be found. No operation will be attempted for that module."
                End If
            End If
        End If
    Next i
End With
Run Code Online (Sandbox Code Playgroud)

运行之后,我注意到一些模块不再出现,而有些模块有重复(例如mymodule和mymodule1).在逐步执行代码时,很明显一些模块在Remove调用后仍然存在,并且在仍然在项目中时它们会被重新导入.有时,这只会导致模块后缀1,但有时我同时拥有原始版本和副本.

有没有办法刷新电话Remove,Import所以他们自己申请?我想Save在每个之后调用一个函数,如果Application对象中有一个函数,虽然如果在导入过程中出现问题,这会导致丢失.

想法?

编辑:将标签更改synchronizationversion-control.

小智 12

这是一个实时数组,您在迭代期间添加和删除项目,从而更改索引号.尝试向后处理数组.这是我的解决方案没有任何错误处理:

Private Const DIR_VERSIONING As String = "\\VERSION_CONTROL"
Private Const PROJ_NAME As String = "PROJECT_NAME"

Sub EnsureProjectFolder()
    ' Does this project directory exist
    If Len(Dir(DIR_VERSIONING & PROJ_NAME, vbDirectory)) = 0 Then
        ' Create it
        MkDir DIR_VERSIONING & PROJ_NAME
    End If
End Sub

Function ProjectFolder() As String
    ' Ensure the folder exists whenever we try to access it (can be deleted mid execution)
    EnsureProjectFolder
    ' Create the required full path
    ProjectFolder = DIR_VERSIONING & PROJ_NAME & "\"
End Function

Sub SaveCodeModules()

    'This code Exports all VBA modules
    Dim i%, sName$

    With ThisWorkbook.VBProject
        ' Iterate all code files and export accordingly
        For i% = 1 To .VBComponents.count
            ' Extract this component name
            sName$ = .VBComponents(i%).CodeModule.Name
            If .VBComponents(i%).Type = 1 Then
                ' Standard Module
                .VBComponents(i%).Export ProjectFolder & sName$ & ".bas"
            ElseIf .VBComponents(i%).Type = 2 Then
                ' Class
                .VBComponents(i%).Export ProjectFolder & sName$ & ".cls"
            ElseIf .VBComponents(i%).Type = 3 Then
                ' Form
                .VBComponents(i%).Export ProjectFolder & sName$ & ".frm"
            ElseIf .VBComponents(i%).Type = 100 Then
                ' Document
                .VBComponents(i%).Export ProjectFolder & sName$ & ".bas"
            Else
                ' UNHANDLED/UNKNOWN COMPONENT TYPE
            End If
        Next i
    End With

End Sub

Sub ImportCodeModules()
    Dim i%, sName$

    With ThisWorkbook.VBProject
        ' Iterate all components and attempt to import their source from the network share
        ' Process backwords as we are working through a live array while removing/adding items
        For i% = .VBComponents.count To 1 Step -1
            ' Extract this component name
            sName$ = .VBComponents(i%).CodeModule.Name
            ' Do not change the source of this module which is currently running
            If sName$ <> "VersionControl" Then
                ' Import relevant source file if it exists
                If .VBComponents(i%).Type = 1 Then
                    ' Standard Module
                    .VBComponents.Remove .VBComponents(sName$)
                    .VBComponents.Import fileName:=ProjectFolder & sName$ & ".bas"
                ElseIf .VBComponents(i%).Type = 2 Then
                    ' Class
                    .VBComponents.Remove .VBComponents(sName$)
                    .VBComponents.Import fileName:=ProjectFolder & sName$ & ".cls"
                ElseIf .VBComponents(i%).Type = 3 Then
                    ' Form
                    .VBComponents.Remove .VBComponents(sName$)
                    .VBComponents.Import fileName:=ProjectFolder & sName$ & ".frm"
                ElseIf .VBComponents(i%).Type = 100 Then
                    ' Document
                    Dim TempVbComponent, FileContents$
                    ' Import the document. This will come in as a class with an increment suffix (1)
                    Set TempVbComponent = .VBComponents.Import(ProjectFolder & sName$ & ".bas")

                    ' Delete any lines of data in the document
                    If .VBComponents(i%).CodeModule.CountOfLines > 0 Then .VBComponents(i%).CodeModule.DeleteLines 1, .VBComponents(i%).CodeModule.CountOfLines

                    ' Does this file contain any source data?
                    If TempVbComponent.CodeModule.CountOfLines > 0 Then
                        ' Pull the lines into a string
                        FileContents$ = TempVbComponent.CodeModule.Lines(1, TempVbComponent.CodeModule.CountOfLines)
                        ' And copy them to the correct document
                        .VBComponents(i%).CodeModule.InsertLines 1, FileContents$
                    End If

                    ' Remove the temporary document class
                    .VBComponents.Remove TempVbComponent
                    Set TempVbComponent = Nothing

                Else
                    ' UNHANDLED/UNKNOWN COMPONENT TYPE
                End If
            End If
            Next i
        End With

End Sub
Run Code Online (Sandbox Code Playgroud)

  • 如果可能的话,我会给+2.首先,您揭示了错误的真正原因:编辑实时数组; 这是我的一个非常愚蠢的错误,我不太确定这些数组是如何工作的.原来他们实际上是`Collection`对象.其次,您的代码正确处理_different类型的modules_并使用适当的文件扩展名保存它们.我改变了我的代码以便在不久前做到这一点,确实非常重要; +1显示你的代码,这样做,所以人们会知道. (2认同)