Модуль для очистки проектов ACCESS от мусора (ADO)
Автор Дмитрий Сонных (aka Joss)   
27.01.2008 г.
Модуль Юрия Шермана для очистки от мусора и исправления других модулей , не работает в ADP т.к. использует DAO.
Это измененный вариант даннойго модуля с использованием ADO.

'----------------------------------------------------------------------
' Module    : ClearModules
' DateTime  : 16.01.2008 00:42
' Release   : 1.2
' Author    : Юрий Шерман, доработан под ADO Дмитрием Сонных (aka Joss)
' Purpose   : Очистка модулей и запросов от мусора.
'----------------------------------------------------------------------
Option Compare Database
Option Explicit


' Комментарий: при корректировке модулей A-97, A-2000
' оставляет мусор,
' который не устраняется стандартными способами
' (Compact, Import).
'
'ПОРЯДОК ИСПОЛЬЗОВАНИЯ ПРОГРАММЫ
'0. Сделайте на всякий случай копию базы.
'1. Включите модуль ClearModules в состав модулей Вашей
'базы.
'2. Запустите программу ClearMdl, например, из отладчика
'или с помощью F5, предварительно установив курсор на
'исполняемый текст программы.
'3. Сожмите базу данных после окончания работы программы,
'и Вы будете приятно удивлены новым размером Вашей базы.

Public Function ClearMdl()
Dim mdl As Module, arrNames() As String, strName As String
Dim PathTempFile As String, ContainerName As String
Dim i As Long, j As Long, k As Long, m As Long, n As Long
Dim S As String

'Эти константы можно изменять
'имя модуля с этой программой
Const MyModuleName As String = "ClearModules"

'имя временного файла для переписи тектов модулей
Const FileTempName As String = "~Module.txt"

'Разместим временный файл для перекачки модулей в своем каталоге
S = CurrentProject.FullName
PathTempFile = Left(S, Len(S) - Len(Dir(S))) + FileTempName

On Error GoTo ErrClear

'Основной цикл по видам контейнеров
For i = 1 To 3
    Select Case i
    Case 1
       ContainerName = "Forms"
       n = CurrentProject.AllForms.Count - 1
    Case 2
       ContainerName = "Reports"
       n = CurrentProject.AllReports.Count - 1
    Case 3
       ContainerName = "Modules"
       n = CurrentProject.AllModules.Count - 1
    End Select

    If n < 0 Then GoTo Nexti

'Запоминаем список документов
   ReDim arrNames(n)
    For j = 0 To n
        Select Case i
        Case 1
            arrNames(j) = CurrentProject.AllForms(j).Name
        Case 2
            arrNames(j) = CurrentProject.AllReports(j).Name
        Case 3
            arrNames(j) = CurrentProject.AllModules(j).Name
    End Select
    Next j

   SysCmd acSysCmdInitMeter, ContainerName, (n + 1)

'Цикл по документам
    For j = 0 To n

'Открываем модуль, если он есть
       strName = arrNames(j)
        Select Case i
        Case 1
           DoCmd.OpenForm strName, acDesign, , , , acHidden
            If Not Forms(strName).HasModule Then GoTo Nextj
            Set mdl = Forms(strName).Module
        Case 2
           DoCmd.OpenReport strName, acDesign
            If Not Reports(strName).HasModule Then GoTo Nextj
            Set mdl = Reports(strName).Module
        Case 3
            If strName = MyModuleName Then GoTo Nextj
           DoCmd.OpenModule strName
            Set mdl = Modules(strName)
        End Select

'Переписываем модуль в текстовый файл
        If Dir(PathTempFile) <> "" Then Kill PathTempFile
        Open PathTempFile For Binary Access Write As #1
        For k = 1 To mdl.CountOfLines
           S = mdl.Lines(k, 1) & Chr(13)
           m = m + Len(S)     'счетчик переписанных байтов
           Put #1, , S
        Next k
        Close #1

'Удаляем старый модуль и создаем пустой новый
        Select Case i
        Case 1
           Forms(strName).HasModule = False
           DoCmd.Save acForm, strName
           Forms(strName).HasModule = True
           Set mdl = Forms(strName).Module
        Case 2
           Reports(strName).HasModule = False
           DoCmd.Save acReport, strName
           Reports(strName).HasModule = True
           Set mdl = Reports(strName).Module
        Case 3
           If mdl.Type Then
              DoCmd.RunCommand acCmdNewObjectClassModule
           Else
              DoCmd.RunCommand acCmdNewObjectModule
           End If
           S = Modules(Modules.Count - 1).Name
           DoCmd.Close acModule, strName
           DoCmd.DeleteObject acModule, strName
           DoCmd.Save acModule, S
           DoCmd.Close acModule, S
           DoCmd.Rename strName, acModule, S
           DoCmd.OpenModule strName
           Set mdl = Modules(strName)
        End Select

'Удаляем в новом модуле стандартные строки
       mdl.DeleteLines 1, mdl.CountOfLines

'Загружаем текст модуля из файла
       mdl.AddFromFile PathTempFile

Nextj:
'Записываем обновленный модуль в базу
        Select Case i
        Case 1: DoCmd.Close acForm, strName, acSaveYes
        Case 2: DoCmd.Close acReport, strName, acSaveYes
        Case 3: If strName <> MyModuleName Then DoCmd.Close acModule, strName, acSaveYes
        End Select
       SysCmd acSysCmdUpdateMeter, (j + 1)
    Next j
Nexti:
Next i

If Dir(PathTempFile) <> "" Then Kill PathTempFile
SysCmd acSysCmdClearStatus
MsgBox "Конец работы." + vbCrLf + " Переписано " & _
   Format(m, "# ### ### ### ##0") & " байт.", vbInformation
Exit Function

ErrClear:
MsgBox "Ошибка при обработке: ContainerName= " & ContainerName & _
   ", DocumentName= " & strName & Chr(13) & _
   "№ ошибки= " & Err & ". " & Err.Description
Stop
Resume
End Function
'--------------------------------------------------------------------------------
'Конец текста модуля



Просмотров: 10696

  Коментарии (9)
 1 Написал(а) час, в 16:35 27.01.2008
Юрий Шерман - самый лучий учитель. 
Я на его статьях рос. 
Всё дожодчиво всё толково всё для людей! :)
 2 Написал(а) час, в 16:48 27.01.2008
Вот только натыкается этот модуль на самого себя и говорит не могу изменить имя модуля ошибка:29040 вот така штука.
 3 Написал(а) Глюкман, в 04:47 19.03.2008
отлично! 
:)
 4 Написал(а) Joss, в 07:22 19.03.2008
Скорее всего вы присвоили модулю не то имя. Должно быть "ClearModules". Имя задается в константой 
Const MyModuleName As String = "ClearModules" 
а при сохранении делается проверка 
If strName MyModuleName Then DoCmd.Close acModule, strName, acSaveYes 
и модуль с этим именем обходится.
 5 Написал(а) Этот e-mail защищен от спам-ботов. Для его просмотра в вашем браузере должна быть включена поддержка Java-script , в 09:22 19.03.2008
Прикольно. У меня после запуска модуля заработало событие Form_ApplyFilter в форме. До этого не работало, я уже было смирился.
 6 Написал(а) m0r0z, в 19:45 29.05.2008
Хороший и полезный модуль, все работает :)
 7 Написал(а) Сергей, в 05:27 03.12.2008
"Purpose : Очистка модулей и запросов от мусора." 
а где и от чего чистятся запросы?!
 8 Написал(а) Этот e-mail защищен от спам-ботов. Для его просмотра в вашем браузере должна быть включена поддержка Java-script , в 08:11 14.04.2018
Там просто описка. Должно быть: "Очистка модулей, форм и отчётов от мусора."
 9 Написал(а) Этот e-mail защищен от спам-ботов. Для его просмотра в вашем браузере должна быть включена поддержка Java-script , в 13:50 07.11.2018
Это просто описка. Обрабатываются модули, формы и отчёты.

Добавить коментарий
Имя:
E-mail
Коментарий:



Код:* Code