MyTetra Share
Делитесь знаниями!
Программно снять пароль с VBAProject
Время создания: 31.07.2019 22:37
Текстовые метки: VBAProject, vbom
Раздел: Разные закладки - VBA
Запись: xintrea/mytetra_db_adgaver_new/master/base/1521832672685wjhqmx4/text.html на raw.githubusercontent.com

А поиск вообще по этому поводу ничего не говорит?

Как программно снять пароль с VBA проекта?


Можно еще так попробовать (по-другому, но тоже SendKeys):


' Снимает защиту проекта. Идея: http://www.rondebruin.nl/

Private Sub UnprotectVBProject(wb As Workbook, ByVal Password As String)

    Dim vbProj As Object, vbCtl As Object

    Set vbProj = wb.VBProject

 

    'can't do it if already unlocked!

    If vbProj.Protection <> 1 Then

        Exit Sub

    End If

 

    Set Application.VBE.ActiveVBProject = vbProj

     

    If Application.VBE.ActiveVBProject.Name <> vbProj.Name Then

      Exit Sub

    End If

 

    Set vbCtl = Application.VBE.CommandBars(1).FindControl(ID:=2578, recursive:=True)

    With vbCtl

        .Reset

        .Execute

    End With

 

    SendKeys Password & "~~", True

End Sub


'что-то не срабатывает, ломает файлы. Не могли бы глянуть, может где ошибка вкралась?

Sub UnprotectVBProject(wb As Workbook, ByVal Password As String)

    Dim vbProj As Object, vbCtl As Object

    Set vbProj = wb.VBProject

  

    'can't do it if already unlocked!

    If vbProj.Protection <> 1 Then

        Exit Sub

    End If

  

    Set Application.VBE.ActiveVBProject = vbProj

      

    If Application.VBE.ActiveVBProject.Name <> vbProj.Name Then

      Exit Sub

    End If

  

    Set vbCtl = Application.VBE.CommandBars(1).FindControl(ID:=2578, recursive:=True)

    With vbCtl

        .Reset

        .Execute

    End With

  

    SendKeys Password & "~~", True

End Sub

 

Sub InsertModuleToTheWorkbooks()

    Dim sFolder As String, sFiles As String

    Dim CurrentModuleNumber As Long

    Dim wbFDP As Workbook

    Dim CurrentModule As String

    Dim objVBProject As Object

    Dim objVBComponent As Object

    Dim objWindow As Object

   

    sFolder = "C:\...\" 'folder path

    sFiles = Dir(sFolder & "*.XLSM") 'file path

  

    Do While sFiles <> ""

        Set wbFDP = Workbooks.Open(sFolder & sFiles) 'open workbook

        Set objVBProject = wbFDP.VBProject

         

        UnprotectVBProject wbFDP, "123" 'unprotect VBA Project

         

        'remove 5 old modules

        For CurrentModuleNumber = 1 To 5

            CurrentModule = "Module" & CurrentModuleNumber

            With wbFDP.VBProject.VBComponents

                .Remove wbFDP.VBProject.VBComponents(CurrentModule)

            End With

        Next CurrentModuleNumber

         

        'install 6 new modules

        For CurrentModuleNumber = 1 To 6

            CurrentModule = "Module" & CurrentModuleNumber

            With wbFDP.VBProject.VBComponents

                .Import "C:\...\" & CurrentModule & ".bas" 'path to new modules

            End With

        Next CurrentModuleNumber

        wbFDP.Close True

 

        sFiles = Dir

    Loop

 

Set objVBProject = Nothing:  Set objWindow = Nothing

 

End Sub


В Вашем коде из #11 есть цикл по удалению модулей с именами Module1-Module5. В книге из #1 есть только Module1. Если конец цикла в строке 44 изменить на 1, то при 'выполнении макроса с проекта снимается защита и удаляется Module1 (проверил). Вставку модулей не проверял.



Так же в этом разделе:
 
MyTetra Share v.0.65
Яндекс индекс цитирования