Хитрости »
Основные понятия (23)
Сводные таблицы и анализ данных (9)
Графики и диаграммы (5)
Работа с VB проектом (12)
Power BI и Power Query (14)
Условное форматирование (5)
Списки и диапазоны (5)
Макросы(VBA процедуры) (63)
Разное (38)
Баги и глюки Excel (2)

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

Большинство наверняка знает как установить/снять пароль с VBA проекта вручную:

  1. Tools-VBAProject Properties-вкладка Protection;
  2. для защиты устанавливается галочка "Lock project for viewing"; для разблокировки - снимается;
  3. вписывается/удаляется сам пароль в полях Password и Confirm password.

Предположу, что не очень многим может понадобиться снимать пароль с проекта VBA средствами самого VBA. Но все же данная тема имеет спрос, как я смог убедиться, общаясь на форумах. Прежде всего это может пригодиться тем, кто создает свои приложения на VBA и периодически нужно вносить изменения в уже созданные проекты(например копирование модулей и кодов из одного проекта в другой). Сразу оговорюсь: я не рассматриваю ситуации, когда вам неизвестен пароль к проекту. Предполагается, что вы знаете пароль и можете снять его вручную.

Я лично знаю два способа снять пароль программно: через метод SendKeys и использовании функций API. Т.к. второй способ довольно громоздкий и сложный для понимания - я в данной статье опишу лишь первый способ. Он не содежит каких-либо изысков и довольно прост.

Sub Unprotect_VBA()
    Dim objVBProject As Object, objVBComponent As Object, objWindow As Object
 
    Workbooks.Open "C:\1.xls"
    Set objVBProject = ActiveWorkbook.VBProject
    'просматриваем все окна проекта в поисках окна снятия защиты
    For Each objWindow In objVBProject.VBE.Windows
        ' Type = 6 - это нужное нам окно
        If objWindow.Type = 6 Then
            objWindow.Visible = True
            objWindow.SetFocus: Exit For
        End If
    Next
    'вводим пароль и подтверждаем ввод
    SendKeys "~1234~", True: SendKeys "{ENTER}", True
    'здесь Ваш код по внесению изменений в проект
    Set objVBProject = Nothing: Set objVBComponent = Nothing: Set objWindow = Nothing
    ActiveWorkbook.Close True
End Sub

Код сначала открывает необходимую книгу, а затем снимает пароль с проекта.

"C:\1.xls" - полный путь к книге, включая расширение файла.

"~1234~" - пароль к проекту. Тильды нужны, но они не являются частью кода. Т.е. сам код это - 1234.

Способ, как видите, действительно очень прост, но это порождает и недостатки. Главный недостаток: снятие пароля данным методом весьма нестабильно и иногда может не срабатывать. Так же во время работы данного кода крайне нежелательно пользоваться мышью и клавиатурой. Точнее даже не нежелательно, а просто нельзя, если вам необходим положительный результат.

Также см.:
[[Копирование модулей и форм из одной книги в другую]]
[[Как удалить макросы в книге?]]
[[Как добавить код процедуры программно, скопировать модуль]]
[[Защита листов/снятие защиты]]


Статья помогла? Поделись ссылкой с друзьями!
  Плейлист   Видеоуроки

Поиск по меткам

Access apple watch Multex Outlook Power Query и Power BI VBA работа в редакторе VBA управление кодами Бесплатные надстройки Дата и время Диаграммы и графики Записки Защита данных Интернет Картинки и объекты Листы и книги Макросы и VBA Надстройки Настройка Печать Поиск данных Политика Конфиденциальности Почта Программы Работа с приложениями Работа с файлами Разработка приложений Сводные таблицы Списки Тренинги и вебинары Финансовые Форматирование Формулы и функции Функции Excel Функции VBA Ячейки и диапазоны акции MulTEx анализ данных баги и глюки в Excel ссылки
Обсуждение: 21 комментарий
  1. yrko-vov:

    У меня к сожалению этот вариант не работает. Если возможно подскажите как снять пароль программно используя функций API.

  2. Bagirchik:

    А как узнать из VBA заблокирован проект или нет? И если проект защищен кодом, то был ли уже введен пароль т.е. доступен ли проект.

  3. Bagirchik:

    Гы, а ларчик просто открывался
    ThisWorkbook.VBProject.Protection

    • MK:

      А Вы не могли бы конкретизировать?
      Я вот выписываю:

      Dim VBPPr As Boolean
      VBPPr = Application.ThisWorkbook.VBProject.Protection

      И мне стабильно выдает False, независимо от того, флаг выставлен или нет.

      • МК, ThisWorkbook это обращение к той книге, в которой записан сам код. Конечно у Вас будет выдавать, что защита снята, т.к. Вы из него же код и запускаете(т.е. пароль снят).

  4. vikvas:

    А ЕСЛИ?, не успеваю нажать Tools-VBAProject Properties тут же выскакивает окно с требованием ввести пароль ...И что делать?

  5. vikvas, может я чего не понимаю? Вы чего хотите сделать? Если проект защищен - то пароль будет запрашиваться сразу же, как только Вы захотите хоть к какому-то свойству обратиться. Вводите пароль и потом уже меняйте свойства проекта. Или Вы рассчитывали, что можно просто взять и не зная пароля снять галку и просмотреть код? А нифиг тогда такой пароль?

  6. Renat898:

    Добрый день. А как сделать защиту от этого макроса с парой десятков циклов перебора? Например если пароль набран неправильно, то книга-жертва закрывается.

  7. Геннадий:

    Добрый день!
    Хочу сделать чтобы проект обновлял сам себя.
    Например смотрел на сайте по ссылке новую версию, качал сначала модуль "содержание", затем импортировал все модули.
    Проблемы две:
    Первая - нужно снять (потом поставить обратно) пароль с VBA на время импорта (таки нужен упомянутый способ через API)
    Вторая - Как получить список всех модулей из файла "донора".
    Буду рад если подскажете решение

    • Геннадий:

      Вторую проблему победил.
      Вот решение, кому интересно.

      Public Enum MyComponents

      MyAll = -1
      MyWorkSheets = 100
      MyModules = 1
      MyClasses = 2
      MyForms = 3

      End Enum

      Public MyModeCopy

      Private Function GetListComponents(wbFromFrom As Workbook)

      Dim Arr() As String
      ReDim Arr(1 To 1)
      Dim objVBProjFrom As Object

      Set objVBProjFrom = wbFromFrom.VBProject

      For Each Comp In objVBProjFrom.VBComponents
      tN = Comp.Name
      tType = Comp.Type
      If tType = MyModeCopy Or MyModeCopy = MyAll Then
      If Arr(UBound(Arr)) Empty Then ReDim Preserve Arr(LBound(Arr) To UBound(Arr) + 1)
      Arr(UBound(Arr)) = tN
      End If
      Next

      GetListComponents = Arr()

      End Function

      Осталось с паролями разобраться.

      • Геннадий:

        Эта строка выглядит так (особенности этого сайта, удалены символы)
        If Arr(UBound(Arr)) НеРавно Empty Then

Поделитесь своим мнением

Комментарии, не имеющие отношения к комментируемой статье, могут быть удалены без уведомления и объяснения причин. Если есть вопрос по личной проблеме - добро пожаловать на Форум


Для оформления сообщений Вы можете использовать следующие тэги:
<a href="" title=""> <abbr title=""> <acronym title=""> <b> <blockquote cite=""> <cite> <code> <del datetime=""> <em> <i> <q cite=""> <s> <strike> <strong>

Тренинги

Заказать
Юридическая информация

Использование материалов сайта

Политика Конфиденциальности

ИП Щербаков Дмитрий Валентинович
ОГРНИП: 318502700083307
ИНН: 504013350772

Наши партнеры

Перейти
Перейти

Счетчики

Рейтинг@Mail.ru Яндекс.Метрика
© 2018 Excel для всех   Войти