Sample Code


Adding A Module To A Project

This code will add new code module named NewModule to the VBProject of the active workbook. The type of VBComponent is specified by the value of the parameter passed to the Add method.

Public Sub AddModuleToProject() 
Dim VBProj As VBIDE.VBProject
Dim VBComp As VBIDE.VBComponent
        
   Set VBProj = ActiveWorkbook.VBProject
   Set VBComp = VBProj.VBComponents.Add(vbext_ct_StdModule)
   VBComp.Name = "NewModule"
End Sub

Adding A Procedure To A Module

This code will add a simple "Hello World" procedure named SayHello to the end of the module named Module1.

    Sub AddProcedureToModule() 
        Dim VBProj As VBIDE.VBProject
        Dim VBComp As VBIDE.VBComponent
        Dim CodeMod As VBIDE.CodeModule
        Dim LineNum As Long
        Const DQUOTE = """" ' one " character

        Set VBProj = ActiveWorkbook.VBProject
        Set VBComp = VBProj.VBComponents("Module1")
        Set CodeMod = VBComp.CodeModule
        
        With CodeMod
            LineNum = .CountOfLines + 1
            .InsertLines LineNum, "Public Sub SayHello()"
            LineNum = LineNum + 1
            .InsertLines LineNum, " MsgBox " & DQUOTE & "Hello World" & DQUOTE
            LineNum = LineNum + 1
            .InsertLines LineNum, "End Sub"
        End With
    
    End Sub

Creating An Event Procedure

This code will create a Workbook_Open event procedure. When creating an event procedure, you should use the CreateEventProc method so that the correct procedure declaration and parameter list is used. CreateEventProc will create the declaration line and the end of procedure line. It returns the line number on which the event procedure begins.


    Sub CreateEventProcedure() 
        Dim VBProj As VBIDE.VBProject
        Dim VBComp As VBIDE.VBComponent
        Dim CodeMod As VBIDE.CodeModule
        Dim LineNum As Long
        Const DQUOTE = """" ' one " character

        Set VBProj = ActiveWorkbook.VBProject
        Set VBComp = VBProj.VBComponents("ThisWorkbook")
        Set CodeMod = VBComp.CodeModule
        
        With CodeMod
            LineNum = .CreateEventProc("Open", "Workbook")
            LineNum = LineNum + 1
            .InsertLines LineNum, " MsgBox " & DQUOTE & "Hello World" & DQUOTE
        End With
    End Sub


Deleting A Module From A Project

This code will delete Module1 from the VBProject. Note that you cannot remove any of the Sheet modules or the ThisWorkbook module. In general, you cannot delete a module whose Type is vbext_ct_Document.


    Sub DeleteModule() 
        Dim VBProj As VBIDE.VBProject
        Dim VBComp As VBIDE.VBComponent
    
        Set VBProj = ActiveWorkbook.VBProject
        Set VBComp = VBProj.VBComponents("Module1")
        VBProj.VBComponents.Remove VBComp
    End Sub


Deleting A Procedure From A Module

This code will delete the procedure DeleteThisProc from the Module1. You must specify the procedure type in order to differentiate between Property Get, Property Let, and Property Set procedure, all of which have the same name.


    Sub DeleteProcedureFromModule() 
        Dim VBProj As VBIDE.VBProject
        Dim VBComp As VBIDE.VBComponent
        Dim CodeMod As VBIDE.CodeModule
        Dim StartLine As Long
        Dim NumLines As Long
        Dim ProcName As String
        
        Set VBProj = ActiveWorkbook.VBProject
        Set VBComp = VBProj.VBComponents("Module1")
        Set CodeMod = VBComp.CodeModule
    
        ProcName = "DeleteThisProc"
        With CodeMod
            StartLine = .ProcStartLine(ProcName, vbext_pk_Proc)
            NumLines = .ProcCountLines(ProcName, vbext_pk_Proc)
            .DeleteLines StartLine:=StartLine, Count:=NumLines
        End With
    End Sub


Deleting All VBA Code In A Project

This code will delete ALL VBA code in a VBProject.


    Sub DeleteAllVBACode() 
        Dim VBProj As VBIDE.VBProject
        Dim VBComp As VBIDE.VBComponent
        Dim CodeMod As VBIDE.CodeModule
        
        Set VBProj = ActiveWorkbook.VBProject
        
        For Each VBComp In VBProj.VBComponents
            If VBComp.Type = vbext_ct_Document Then
                Set CodeMod = VBComp.CodeModule
                With CodeMod
                    .DeleteLines 1, .CountOfLines
                End With
            Else
                VBProj.VBComponents.Remove VBComp
            End If
        Next VBComp
    End Sub


Exporting A VBComponent Code Module To A Text File

You can export an existing VBComponent CodeModule to a text file. This can be useful if you are archiving modules to create a library of useful module to be used in other projects.


    Public Function ExportVBComponent(VBComp As VBIDE.VBComponent, _ 
                FolderName As String, _
                Optional FileName As String, _
                Optional OverwriteExisting As Boolean = True) As Boolean
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' This function exports the code module of a VBComponent to a text
' file. If FileName is missing, the code will be exported to
' a file with the same name as the VBComponent followed by the
' appropriate extension.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    Dim Extension As String
    Dim FName As String
    Extension = GetFileExtension(VBComp:=VBComp)
    If Trim(FileName) = vbNullString Then
        FName = VBComp.Name & Extension
    Else
        FName = FileName
        If InStr(1, FName, ".", vbBinaryCompare) = 0 Then
            FName = FName & Extension
        End If
    End If
    
    If StrComp(Right(FolderName, 1), "\", vbBinaryCompare) = 0 Then
        FName = FolderName & FName
    Else
        FName = FolderName & "\" & FName
    End If
    
    If Dir(FName, vbNormal + vbHidden + vbSystem) <> vbNullString Then
        If OverwriteExisting = True Then
            Kill FName
        Else
            ExportVBComponent = False
            Exit Function
        End If
    End If
    
    VBComp.Export FileName:=FName
    ExportVBComponent = True
    
    End Function
    
    Public Function GetFileExtension(VBComp As VBIDE.VBComponent) As String
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' This returns the appropriate file extension based on the Type of
' the VBComponent.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        Select Case VBComp.Type
            Case vbext_ct_ClassModule
                GetFileExtension = ".cls"
            Case vbext_ct_Document
                GetFileExtension = ".cls"
            Case vbext_ct_MSForm
                GetFileExtension = ".frm"
            Case vbext_ct_StdModule
                GetFileExtension = ".bas"
            Case Else
                GetFileExtension = ".bas"
        End Select
        
    End Function


Listing All Modules In A Project

This code will list all the modules and their types in the workbook, starting the listing in cell A1.


    Sub ListModules() 
        Dim VBProj As VBIDE.VBProject
        Dim VBComp As VBIDE.VBComponent
        Dim WS As Worksheet
        Dim Rng As Range
        
        Set VBProj = ActiveWorkbook.VBProject
        Set WS = ActiveWorkbook.Worksheets("Sheet1")
        Set Rng = WS.Range("A1")
        
        For Each VBComp In VBProj.VBComponents
            Rng(1, 1).Value = VBComp.Name
            Rng(1, 2).Value = ComponentTypeToString(VBComp.Type)
            Set Rng = Rng(2, 1)
        Next VBComp
    End Sub

    Function ComponentTypeToString(ComponentType As VBIDE.vbext_ComponentType) As String 
        Select Case ComponentType
            Case vbext_ct_ActiveXDesigner
                ComponentTypeToString = "ActiveX Designer"
            Case vbext_ct_ClassModule
                ComponentTypeToString = "Class Module"
            Case vbext_ct_Document
                ComponentTypeToString = "Document Module"
            Case vbext_ct_MSForm
                ComponentTypeToString = "UserForm"
            Case vbext_ct_StdModule
                ComponentTypeToString = "Code Module"
            Case Else
                ComponentTypeToString = "Unknown Type: " & CStr(ComponentType)
        End Select
    End Function


Listing All Procedures In A Module

This code will list all the procedures in Module1, beginning the listing in cell A1.

    Sub ListProcedures() 
        Dim VBProj As VBIDE.VBProject
        Dim VBComp As VBIDE.VBComponent
        Dim CodeMod As VBIDE.CodeModule
        Dim LineNum As Long
        Dim NumLines As Long
        Dim WS As Worksheet
        Dim Rng As Range
        Dim ProcName As String
        Dim ProcKind As VBIDE.vbext_ProcKind
        
        Set VBProj = ActiveWorkbook.VBProject
        Set VBComp = VBProj.VBComponents("Module1")
        Set CodeMod = VBComp.CodeModule
        
        Set WS = ActiveWorkbook.Worksheets("Sheet1")
        Set Rng = WS.Range("A1")
        
        With CodeMod
            LineNum = .CountOfDeclarationLines + 1
            ProcName = .ProcOfLine(LineNum, ProcKind)
            Do Until LineNum >= .CountOfLines
                Rng(1, 1).Value = ProcName
                Rng(1, 2).Value = ProcKindString(ProcKind)
                
                Set Rng = Rng(2, 1)
                LineNum = LineNum + .ProcCountLines(ProcName, ProcKind) + 1
                
                ProcName = .ProcOfLine(LineNum, ProcKind)
            Loop
        End With
    End Sub
    
    
    Function ProcKindString(ProcKind As VBIDE.vbext_ProcKind) As String
        Select Case ProcKind
            Case vbext_pk_Get
                ProcKindString = "Property Get"
            Case vbext_pk_Let
                ProcKindString = "Property Let"
            Case vbext_pk_Set
                ProcKindString = "Property Set"
            Case vbext_pk_Proc
                ProcKindString = "Sub Or Function"
            Case Else
                ProcKindString = "Unknown Type: " & CStr(ProcKind)
        End Select
    End Function

Searching For Text In A Module

The CodeModule object has a Find method that you can use to search for text within the code module. The Find method accepts ByRef Long parameters. Upon input, these parameters specify the range of lines and column to search. On output, these values will point to the found text. To find the second and subsequent occurence of the text, you need to set the parameters to refer to the text following the found line and column. The Find method returns True or False indicating whether the text was found. The code below will search all of the code in Module1 and print a Debug message for each found occurrence. Note the values set with the SL, SC, EL, and EC variables. The code loops until the Found variable is False.

Sub SearchCodeModule() 
        Dim VBProj As VBIDE.VBProject
        Dim VBComp As VBIDE.VBComponent
        Dim CodeMod As VBIDE.CodeModule
        Dim FindWhat As String
        Dim SL As Long ' start line
        Dim EL As Long ' end line
        Dim SC As Long ' start column
        Dim EC As Long ' end column
        Dim Found As Boolean
        
        Set VBProj = ActiveWorkbook.VBProject
        Set VBComp = VBProj.VBComponents("Module1")
        Set CodeMod = VBComp.CodeModule
        
        FindWhat = "findthis"
        
        With CodeMod
            SL = 1
            EL = .CountOfLines
            SC = 1
            EC = 255
            Found = .Find(target:=FindWhat, StartLine:=SL, StartColumn:=SC, _
                EndLine:=EL, EndColumn:=EC, _
                wholeword:=True, MatchCase:=False, patternsearch:=False)
            Do Until Found = False
                Debug.Print "Found at: Line: " & CStr(SL) & " Column: " & CStr(SC)
                EL = .CountOfLines
                SC = EC + 1
                EC = 255
                Found = .Find(target:=FindWhat, StartLine:=SL, StartColumn:=SC, _
                    EndLine:=EL, EndColumn:=EC, _
                    wholeword:=True, MatchCase:=False, patternsearch:=False)
            Loop
        End With
    End Sub


Testing If A VBComponent Exists

This code will return True or False indicating whether the VBComponent named by VBCompName exists in the project referenced by VBProj. If VBProj is omitted, the VBProject of the ActiveWorkbook is used.


    Public Function VBComponentExists(VBCompName As String, Optional VBProj As VBIDE.VBProject = Nothing) As Boolean 
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' This returns True or False indicating whether a VBComponent named
' VBCompName exists in the VBProject referenced by VBProj. If VBProj
' is omitted, the VBProject of the ActiveWorkbook is used.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        Dim VBP As VBIDE.VBProject
        If VBProj Is Nothing Then
            Set VBP = ActiveWorkbook.VBProject
        Else
            Set VBP = VBProj
        End If
        On Error Resume Next
        VBComponentExists = CBool(Len(VBP.VBComponents(VBCompName).Name))
    
End Function


Total Code Lines In A Component

This function will return the total code lines in a VBComponent. It ignores blank lines and comment lines. It will return -1 if the project is locked.


    Public Function TotalCodeLinesInVBComponent(VBComp As VBIDE.VBComponent) As Long 
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' This returns the total number of code lines (excluding blank lines and
' comment lines) in the VBComponent referenced by VBComp. Returns -1
' if the VBProject is locked.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        Dim N As Long
        Dim S As String
        Dim LineCount As Long
        
        If VBComp.Collection.Parent.Protection = vbext_pp_locked Then
            TotalCodeLinesInVBComponent = -1
            Exit Function
        End If
        
        With VBComp.CodeModule
            For N = 1 To .CountOfLines
                S = .Lines(N, 1)
                If Trim(S) = vbNullString Then
' blank line, skip it
                ElseIf Left(Trim(S), 1) = "'" Then
' comment line, skip it
                Else
                    LineCount = LineCount + 1
                End If
            Next N
        End With
        TotalCodeLinesInVBComponent = LineCount
    End Function


Total Lines In A Project

This code will return the count of lines in all components of the project referenced by VBProj. If VBProj is omitted, the VBProject of the ActiveWorkbook is used. The function will return -1 if the project is locked.


    Public Function TotalLinesInProject(Optional VBProj As VBIDE.VBProject = Nothing) As Long
    
        Dim VBP As VBIDE.VBProject
        Dim VBComp As VBIDE.VBComponent
        Dim LineCount As Long
        
        If VBProj Is Nothing Then
            Set VBP = ActiveWorkbook.VBProject
        Else
            Set VBP = VBProj
        End If
        
        If VBP.Protection = vbext_pp_locked Then
            TotalLinesInProject = -1
            Exit Function
        End If
        
        For Each VBComp In VBP.VBComponents
            LineCount = LineCount + VBComp.CodeModule.CountOfLines
        Next VBComp
        
        TotalLinesInProject = LineCount
    End Function

Total Code Lines In A Component

This function will return the total number of code lines in a VBComponent. It ignores blank lines and comment lines. It will return -1 if the project is locked.


    Public Function TotalCodeLinesInVBComponent(VBComp As VBIDE.VBComponent) As Long 
        Dim N As Long
        Dim S As String
        Dim LineCount As Long
        
        If VBComp.Collection.Parent.Protection = vbext_pp_locked Then
            TotalCodeLinesInVBComponent = -1
            Exit Function
        End If
        
        With VBComp.CodeModule
            For N = 1 To .CountOfLines
                S = .Lines(N, 1)
                If Trim(S) = vbNullString Then
' blank line, skip it
                ElseIf Left(Trim(S), 1) = "'" Then
' comment line, skip it
                Else
                    LineCount = LineCount + 1
                End If
            Next N
        End With
        TotalCodeLinesInVBComponent = LineCount
    End Function


Total Code Lines In A Project

This function will return the total number of code lines in all the components of a VBProject. It ignores blank lines and comment lines. It will return -1 if the project is locked.


    Public Function TotalCodeLinesInProject(VBProj As VBIDE.VBProject) As Long 
        
        Dim VBComp As VBIDE.VBComponent
        Dim LineCount As Long
        If VBProj.Protection = vbext_pp_locked Then
            TotalCodeLinesInProject = -1
            Exit Function
        End If
        For Each VBComp In VBProj.VBComponents
            LineCount = LineCount + TotalCodeLinesInVBComponent(VBComp)
        Next VBComp
        
        TotalCodeLinesInProject = LineCount
    End Function

Procnames Function

Function to return the names of Procedures in a given module

Function ProcNames(ByRef strMName As String) As String() 
    Dim lngSLine As Long ' Line Number
    Dim vbCodeMod As CodeModule ' Object for Code Module
    Dim intPCount As Integer ' Procedure Count
    Dim pnamearray() As String ' Procedure Names Array
' Set named module as module object
    Set vbCodeMod = ThisWorkbook.VBProject.VBComponents(strMName).CodeModule
' Scan through module looking for Declaration lines
' and set up array of macro names as we go
    With vbCodeMod
        lngSLine = .CountOfDeclarationLines + 1
        Do Until lngSLine >= .CountOfLines
            intPCount = intPCount + 1
            ReDim Preserve pnamearray(intPCount)
            pnamearray(intPCount) = .ProcOfLine(lngSLine, vbext_pk_Proc)
            lngSLine = lngSLine + .ProcCountLines(.ProcOfLine(lngSLine, vbext_pk_Proc), vbext_pk_Proc)
        Loop
    End With
' Return array of Procedure names
    ProcNames = pnamearray()
End Function


ModExist Function

This function test to see if a given VBA module exists in the current project.

Function ModExist(strModName As String) As Boolean 
    Dim intVBCcnt As Integer
    Dim intVBDcnt As Integer
    Dim intLC1 As Integer
' Set up count of modules in project
    intVBCcnt = ThisWorkbook.VBProject.VBComponents.Count
    intVBDcnt = 0
' Loop through module names
    For intLC1 = 1 To intVBCcnt
        If ThisWorkbook.VBProject.VBComponents(intLC1).Type = vbext_ct_StdModule Then
            If ThisWorkbook.VBProject.VBComponents(intLC1).Name = strModName Then
                ModExist = True
                GoTo Exit_ModExist
            End If
        End If
    Next intLC1
    ModExist = False
Exit_ModExist:
End Function


© 2019 Better Solutions Limited. All Rights Reserved. © 2019 Better Solutions Limited TopPrevNext