Экспорт форм доступа MS и классов/модулей Рекурсивно в текстовые файлы?

Ответ 1

Вы также можете попробовать этот код. Это сохранит типы файлов элементов (.bas,.cls,.frm) Не забудьте обратиться к/проверить библиотеку Microsoft Visual Basic для приложений в VBE> Инструменты> Ссылки

Public Sub ExportAllCode()

    Dim c As VBComponent
    Dim Sfx As String

    For Each c In Application.VBE.VBProjects(1).VBComponents
        Select Case c.Type
            Case vbext_ct_ClassModule, vbext_ct_Document
                Sfx = ".cls"
            Case vbext_ct_MSForm
                Sfx = ".frm"
            Case vbext_ct_StdModule
                Sfx = ".bas"
            Case Else
                Sfx = ""
        End Select

        If Sfx <> "" Then
            c.Export _
                Filename:=CurrentProject.Path & "\" & _
                c.Name & Sfx
        End If
    Next c

End Sub

Ответ 2

Вы можете использовать объект Access.Application.

Кроме того, чтобы избежать нескольких диалоговых окон подтверждения при открытии баз данных, просто измените уровень безопасности в Инструменты/Макросы/Безопасность.

А чтобы открыть несколько баз данных с помощью имени пользователя/пароля, вы можете присоединиться к рабочей группе (Инструменты/Безопасность/Администратор рабочей группы) и войти в систему с нужным пользователем/паролем (из базы данных с помощью функции SaveToFile), а затем запустить код. Не забудьте позже присоединиться к рабочей группе по умолчанию (вы можете попытаться присоединиться к несуществующей рабочей группе, и доступ вернется к стандартной).

Option Explicit
Option Compare Database


'Save the code for all modules to files in currentDatabaseDir\Code
Public Function SaveToFile()

   On Error GoTo SaveToFile_Err

   Dim Name As String
   Dim WasOpen As Boolean
   Dim Last As Integer
   Dim i As Integer
   Dim TopDir As String, Path As String, FileName As String
   Dim F As Long                          'File for saving code
   Dim LineCount As Long                  'Line count of current module

   Dim oApp As New Access.Application

   ' Open remote database
   oApp.OpenCurrentDatabase ("D:\Access\myDatabase.mdb"), False


   i = InStrRev(oApp.CurrentDb.Name, "\")
   TopDir = VBA.Left(oApp.CurrentDb.Name, i - 1)
   Path = TopDir & "\" & "Code"           'Path where the files will be written

   If (Dir(Path, vbDirectory) = "") Then
      MkDir Path                           'Ensure this exists
   End If

   '--- SAVE THE STANDARD MODULES CODE ---

   Last = oApp.CurrentProject.AllModules.Count - 1

   For i = 0 To Last
      Name = oApp.CurrentProject.AllModules(i).Name
      WasOpen = True                       'Assume already open

         If Not oApp.CurrentProject.AllModules(i).IsLoaded Then
            WasOpen = False                    'Not currently open
            oApp.DoCmd.OpenModule Name              'So open it
         End If

      LineCount = oApp.Modules(Name).CountOfLines
      FileName = Path & "\" & Name & ".vba"

      If (Dir(FileName) <> "") Then
        Kill FileName                      'Delete previous version
      End If

      'Save current version
      F = FreeFile
      Open FileName For Output Access Write As #F
      Print #F, oApp.Modules(Name).Lines(1, LineCount)
      Close #F

      If Not WasOpen Then
         oApp.DoCmd.Close acModule, Name         'It wasn't open, so close it again
      End If
   Next

   '--- SAVE FORMS MODULES CODE ---

   Last = oApp.CurrentProject.AllForms.Count - 1

   For i = 0 To Last
      Name = oApp.CurrentProject.AllForms(i).Name
      WasOpen = True

      If Not oApp.CurrentProject.AllForms(i).IsLoaded Then
         WasOpen = False
         oApp.DoCmd.OpenForm Name, acDesign
      End If

      LineCount = oApp.Forms(Name).Module.CountOfLines
      FileName = Path & "\" & Name & ".vba"

      If (Dir(FileName) <> "") Then
         Kill FileName
      End If

      F = FreeFile
      Open FileName For Output Access Write As #F
      Print #F, oApp.Forms(Name).Module.Lines(1, LineCount)
      Close #F

      If Not WasOpen Then
         oApp.DoCmd.Close acForm, Name
      End If
   Next

   '--- SAVE REPORTS MODULES CODE ---

   Last = oApp.CurrentProject.AllReports.Count - 1

   For i = 0 To Last
      Name = oApp.CurrentProject.AllReports(i).Name
      WasOpen = True

      If Not oApp.CurrentProject.AllReports(i).IsLoaded Then
         WasOpen = False
         oApp.DoCmd.OpenReport Name, acDesign
      End If

      LineCount = oApp.Reports(Name).Module.CountOfLines
      FileName = Path & "\" & Name & ".vba"

      If (Dir(FileName) <> "") Then
         Kill FileName
      End If

      F = FreeFile
      Open FileName For Output Access Write As #F
      Print #F, oApp.Reports(Name).Module.Lines(1, LineCount)
      Close #F

      If Not WasOpen Then
         oApp.DoCmd.Close acReport, Name
      End If
   Next

   MsgBox "Created source files in " & Path

   ' Reset the security level
   Application.AutomationSecurity = msoAutomationSecurityByUI

SaveToFile_Exit:

   If Not oApp.CurrentDb Is Nothing Then oApp.CloseCurrentDatabase
   If Not oApp Is Nothing Then Set oApp = Nothing
   Exit function

SaveToFile_Err:

   MsgBox ("Error " & Err.Number & vbCrLf & Err.Description)
   Resume SaveToFile_Exit

End Function

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

Я считаю это большим вкладом. Спасибо, что поделились.

Привет

================= ОБНОВЛЕНИЕ ==================

Через некоторое время я нашел способ экспортировать всю базу данных (включая таблицы и запросы) и использовал ее для контроля версий в Git.

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

         Option Compare Database
         Option Explicit

  Private Const VB_MODULE               As Integer = 1
  Private Const VB_CLASS                As Integer = 2
  Private Const VB_FORM                 As Integer = 100
  Private Const EXT_TABLE               As String = ".tbl"
  Private Const EXT_QUERY               As String = ".qry"
  Private Const EXT_MODULE              As String = ".bas"
  Private Const EXT_CLASS               As String = ".cls"
  Private Const EXT_FORM                As String = ".frm"
  Private Const CODE_FLD                As String = "code"

  Private Const mblnSave                As Boolean = True               ' False: just generate the script
'
'

Public Sub saveAllAsText()

            Dim oTable                  As TableDef
            Dim oQuery                  As QueryDef
            Dim oCont                   As Container
            Dim oForm                   As Document
            Dim oModule                 As Object
            Dim FSO                     As Object

            Dim strPath                 As String
            Dim strName                 As String
            Dim strFileName             As String

'**
    On Error GoTo errHandler

    strPath = CurrentProject.path
    Set FSO = CreateObject("Scripting.FileSystemObject")
    strPath = addFolder(FSO, strPath, Application.CurrentProject.name & "_" & CODE_FLD)
    strPath = addFolder(FSO, strPath, Format(Date, "yyyy.mm.dd"))


    For Each oTable In CurrentDb.TableDefs
        strName = oTable.name
        If left(strName, 4) <> "MSys" Then
            strFileName = strPath & "\" & strName & EXT_TABLE
            If mblnSave Then Application.ExportXML acExportTable, strName, strFileName, strFileName & ".XSD", strFileName & ".XSL", , acUTF8, acEmbedSchema + acExportAllTableAndFieldProperties
            Debug.Print "Application.ImportXML """ & strFileName & """, acStructureAndData"
        End If
    Next

    For Each oQuery In CurrentDb.QueryDefs
        strName = oQuery.name
        If left(strName, 1) <> "~" Then
            strFileName = strPath & "\" & strName & EXT_QUERY
            If mblnSave Then Application.SaveAsText acQuery, strName, strFileName
            Debug.Print "Application.LoadFromText acQuery, """ & strName & """, """ & strFileName & """"
        End If
    Next

    Set oCont = CurrentDb.Containers("Forms")
    For Each oForm In oCont.Documents
        strName = oForm.name
        strFileName = strPath & "\" & strName & EXT_FORM
        If mblnSave Then Application.SaveAsText acForm, strName, strFileName
        Debug.Print "Application.LoadFromText acForm, """ & strName & """, """ & strFileName & """"
    Next

    strPath = addFolder(FSO, strPath, "modules")
    For Each oModule In Application.VBE.ActiveVBProject.VBComponents
        strName = oModule.name
        strFileName = strPath & "\" & strName
        Select Case oModule.Type
            Case VB_MODULE
                If mblnSave Then oModule.Export strFileName & EXT_MODULE
                Debug.Print "Application.VBE.ActiveVBProject.VBComponents.Import """ & strFileName & EXT_MODULE; """"
            Case VB_CLASS
                If mblnSave Then oModule.Export strFileName & EXT_CLASS
                Debug.Print "Application.VBE.ActiveVBProject.VBComponents.Import """ & strFileName & EXT_CLASS; """"
            Case VB_FORM
                ' Do not export form modules (already exported the complete forms)
            Case Else
                Debug.Print "Unknown module type: " & oModule.Type, oModule.name
        End Select
    Next

    If mblnSave Then MsgBox "Files saved in  " & strPath, vbOKOnly, "Export Complete"

Exit Sub

errHandler:
    MsgBox "Error " & Err.Number & ": " & Err.Description & vbCrLf
    Stop: Resume

End Sub
'

'
' Create a folder when necessary. Append the folder name to the given path.
'
Private Function addFolder(ByRef FSO As Object, ByVal strPath As String, ByVal strAdd As String) As String
    addFolder = strPath & "\" & strAdd
    If Not FSO.FolderExists(addFolder) Then MkDir addFolder
End Function
'

Ответ 3

Как и для MS Excel, вы также можете использовать цикл над Application.VBE.VBProjects(1).VBComponents и использовать метод Export для экспорта ваших модулей/классов/форм:

Const VB_MODULE = 1
Const VB_CLASS = 2
Const VB_FORM = 100
Const EXT_MODULE = ".bas"
Const EXT_CLASS = ".cls"
Const EXT_FORM = ".frm"
Const CODE_FLD = "Code"

Sub ExportAllCode()

Dim fileName As String
Dim exportPath As String
Dim ext As String
Dim FSO As Object

Set FSO = CreateObject("Scripting.FileSystemObject")
' Set export path and ensure its existence
exportPath = CurrentProject.path & "\" & CODE_FLD
If Not FSO.FolderExists(exportPath) Then
    MkDir exportPath
End If

' The loop over all modules/classes/forms
For Each c In Application.VBE.VBProjects(1).VBComponents
    ' Get the filename extension from type
    ext = vbExtFromType(c.Type)
    If ext <> "" Then
        fileName = c.name & ext
        debugPrint "Exporting " & c.name & " to file " & fileName
        ' THE export
        c.Export exportPath & "\" & fileName
    Else
        debugPrint "Unknown VBComponent type: " & c.Type
    End If
Next c

End Sub

' Helper function that translates VBComponent types into file extensions
' Returns an empty string for unknown types
Function vbExtFromType(ByVal ctype As Integer) As String
    Select Case ctype
        Case VB_MODULE
            vbExtFromType = EXT_MODULE
        Case VB_CLASS
            vbExtFromType = EXT_CLASS
        Case VB_FORM
            vbExtFromType = EXT_FORM
    End Select
End Function

Выполняется только часть секунды.

Приветствия

Ответ 4

Прекрасный ответ Клону.

Небольшое отклонение, если вы пытаетесь открыть MDB с формой запуска и/или макросом AutoExec и выше, не всегда работает надежно.

Глядя на этот ответ на другом веб-сайте: Пропустить форму запуска/макросы и прокручивать почти до конца обсуждения - это некоторый код, который временно избавляется от настроек формы запуска и извлекает макрос AutoExec в вашу базу данных, прежде чем писать над ним с помощью макроса TempAutoExec (который ничего не делает), выполняет некоторую работу (между строк "Чтение командных баров и app.CloseCurrentDatabase" ), а затем исправляет все снова.

Ответ 5

IDK, почему никто не предлагал этого раньше, но вот небольшой фрагмент кода, который я использую для этого. Довольно простой и понятный

Public Sub VBAExportModule()
    On Error GoTo Errg
    Dim rs As DAO.Recordset
    Set rs = CurrentDb.OpenRecordset("SELECT MSysObjects.Name FROM MSysObjects WHERE Type=-32761", dbOpenDynaset, dbSeeChanges)

    Do Until rs.EOF
        Application.SaveAsText acModule, rs("Name"), "C:\" & rs("Name") & ".txt"
        rs.MoveNext
    Loop

Cleanup:
    If Not rs Is Nothing Then rs.Close
    Set rs = Nothing
    Exit Sub
Errg:
    GoTo Cleanup
End Sub

Ответ 6

другой способ - сохранить наиболее используемый код в одном внешнем master.mdb и присоедините его к любому счету *.mdbs через Модули- > Инструменты- > Ссылки- > Обзор → ...\master.mdb

Единственная проблема в старом 97 Access вы можете отлаживать, редактировать и сохранять непосредственно в destination.mdb, но во всех новее, начиная с MA 2000, опция "Сохранить" исчезла и все предупреждения о закрытом несохраненном коде

Ответ 7

Рад, что нашел этот код, но как вы на самом деле его используете. Я сделал модуль, но как мне его выполнить? Я попытался сделать макрос и использовать "RunCode", но там говорилось, что имя моей функции (ExportAllCode) не найдено.