How to automatically change a Module code in multiple protected Visual Basic projects

Marctrix14

New Member
Joined
Aug 2, 2023
Messages
2
Office Version
  1. 2010
Platform
  1. Windows
Hi everyone,

I'm new to Visual Basic. For the past 2 days I've been trying to make functional an automatic code that should process multiple Excels and change one of the modules code from their respective Visual Basic projects.
Each VB project is protected.

I used this following code to protect/unprotect:

The goal is to unprotect each project, check if it has the module entered by prompt; if it has, change its code and finally protect the project again. If it doesn't have that module, then just protect the project again and process the next project.

The problem is in line "If .VBProject.VBComponents(destino).CodeModule Is Nothing Then" because it gets an error and goes to line "etiqueta". The workbook doesn't get unprotected after the function "unprotect". I don't know why, I can't figure it out through debugging.

I'd appreciate receiving any help on how to make my code work.

Thank you.

Marc

PD:

The current code is :
(most comments are in Spanish, but I hope you could understand the code)
VBA Code:
Option Explicit
Sub UNPROTECT_VB_PROJECT(WB As Workbook, ByVal Password As String)
    '
    ' Bill Manville, 29-Jan-2000
    '
    Dim VBP As VBProject, oWin As VBIDE.Window
    Dim wbActive As Workbook
    Dim i As Integer
  
    Set VBP = WB.VBProject
    Set wbActive = ActiveWorkbook
  
  
    If VBP.Protection <> vbext_pp_locked Then Exit Sub
  
  
    Application.ScreenUpdating = False
  
  
    ' close any code windows to ensure we hit the right project
    For Each oWin In VBP.VBE.Windows
      If InStr(oWin.Caption, "(") > 0 Then oWin.Close
    Next oWin
  
  
    WB.Activate
    ' now use lovely SendKeys to unprotect
    Application.OnKey "%{F11}"
    SendKeys "%{F11}%TE" & Password & "~~%{F11}", True
  
  
    If VBP.Protection = vbext_pp_locked Then
      ' failed - maybe wrong password
      SendKeys "%{F11}%TE", True
    End If
  
  
    ' leave no evidence of the password
    Password = ""
    ' go back to the previously active workbook
    wbActive.Activate

End Sub

Sub PROTECT_VB_PROJECT(WB As Workbook, ByVal Password As String)
    Dim VBP As VBProject, oWin As VBIDE.Window
    Dim wbActive As Workbook
    Dim i As Integer
  
  
    Set VBP = WB.VBProject
    Set wbActive = ActiveWorkbook
  
  
    ' close any code windows to ensure we hit the right project
    For Each oWin In VBP.VBE.Windows
        If InStr(oWin.Caption, "(") > 0 Then oWin.Close
    Next oWin
  
  
    WB.Activate
    ' now use lovely SendKeys to unprotect
    Application.OnKey "%{F11}"
    SendKeys "+{TAB}{RIGHT}%V{+}{TAB}" & Password & "{TAB}" & Password & "~"
    Application.VBE.CommandBars(1).FindControl(ID:=2578, recursive:=True).Execute
    WB.Save
  
End Sub

Sub ACTUALIZAR_MODULO()
'Declaramos variables
Dim nArchivos, CodigoCopiar, CodigoPegar
Dim destino As String, NombreLibro As String
Dim FSO As Variant, i As Long, lineas As Long
Dim WB As Workbook
Dim unpassVB As String

'Desactivamos actualización de pantalla
Application.ScreenUpdating = False

'Seleccionamos uno o varios archivos
nArchivos = Application.GetOpenFilename(filefilter:="Excel (*.xls*),*.xls", _
Title:="SELECCIONAR ARCHIVO", MultiSelect:=True)

'si no seleccionamos nada, salimos del proceso
If Not IsArray(nArchivos) Then
    Exit Sub
Else

    'Mostramos inputbox para que el usuario indique el nombre del modulo: standar o de hoja. Si está vacío, salimos del proceso, si está mal escrito mostramos error
    destino = InputBox("INDICA EL NOMBRE DEL MÓDULO O LA HOJA DONDE SE ENCUENTRA EL CÓDIGO A REEMPLAZAR:" & Chr(13) & Chr(13) & "(VERIFICA EL USO DE MAYÚSCULAS O MINÚSCULAS)", "ARCHIVO SELECCIONADO")
  
    If destino = Empty Then
        Exit Sub
    Else
      
        'Solicitamos la contraseña para desproteger el proyecto de Visual Basic para poder editar el código del módulo
        unpassVB = InputBox("ENTRA LA CONTRASEÑA PARA DESPROTEGER EL PROYECTO DE VISUAL BASIC:")
      
      
        'Recorremos mediante un array los archivos seleccionados
        For i = LBound(nArchivos) To UBound(nArchivos)
      
            'Abrimos cada archivo
            Set WB = Workbooks.Open(Filename:=(nArchivos(i)))
                  
            With ActiveWorkbook
            On Error GoTo etiqueta
          
                'Desprotegemos el proyecto de Visual Basic para poder comprobar si existe el módulo para tal archivo
                UNPROTECT_VB_PROJECT WB, unpassVB
              
                'Ignoramos los archivos que no tengan el módulo en cuestión
                If .VBProject.VBComponents(destino).CodeModule Is Nothing Then
                Else
                    'Borramos el código que queremos actualizar en los archivos seleccionados
                    .VBProject.VBComponents(destino).CodeModule.DeleteLines 1, .VBProject.VBComponents(destino).CodeModule.CountOfLines
                  
                    'seleccionamos y copiamos el código de nuestro libro y que está en el módulo CODIGO A COPIAR
                    Set CodigoCopiar = ThisWorkbook.VBProject.VBComponents("CODIGO_A_COPIAR").CodeModule
                    'Pegamos en cada archivo y módulo seleccionado el código que hemos copiado
                    Set CodigoPegar = .VBProject.VBComponents(destino).CodeModule
                    lineas = CodigoCopiar.CountOfLines
                    CodigoPegar.AddFromString CodigoCopiar.Lines(1, lineas)
                  
                  
                End If
              
                'Volvemos a proteger el proyecto de Visual Basic
                PROTECT_VB_PROJECT WB, unpassVB
              
                 'cerramos cada libro que hemos seleccionado y abierto
                WB.Close SaveChanges:=True
              
            End With
etiqueta:
            'Volvemos a proteger el proyecto de Visual Basic
            PROTECT_VB_PROJECT WB, unpassVB
          
            'cerramos cada libro que hemos seleccionado y abierto
            WB.Close SaveChanges:=True
  
        Next i
      
    End If
  
End If

End Sub
 
Last edited by a moderator:

Excel Facts

Round to nearest half hour?
Use =MROUND(A2,"0:30") to round to nearest half hour. Use =CEILING(A2,"0:30") to round to next half hour.
Welcome to the MrExcel Message Board!

Cross-posting (posting the same question in more than one forum) is not against our rules, but the method of doing so is covered by #13 of the Forum Rules.

Be sure to follow & read the link at the end of the rule too!

Cross posted at:

There is no need to repeat the link(s) provided above but if you have posted the question at other places, please provide links to those as well.

If you do cross-post in the future and also provide links, then there shouldn’t be a problem.
 
Upvote 0

Forum statistics

Threads
1,224,813
Messages
6,181,118
Members
453,021
Latest member
Justyna P

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top