Экспорт кода из Microsoft Access

Question

Есть ли способ массового экспорта кода Microsoft Access в файлы? Я вижу, что могу экспортировать один файл за раз, но есть сотни, и я буду здесь весь день. Там нет «Export All» или multi-select export в любом месте?

Answer 1

Чтобы вывести весь код на рабочем столе, в том числе код из форм и отчетов, вы можете вставить это в стандартный модуль и запустить его, нажав F5 или перейдите к F8. Вы можете сначала указать имя папки рабочего стола.

Sub AllCodeToDesktop() 
    ''The reference for the FileSystemObject Object is Windows Script Host Object Model 
    ''but it not necessary to add the reference for this procedure. 

    Dim fs As Object 
    Dim f As Object 
    Dim strMod As String 
    Dim mdl As Object 
    Dim i As Integer 

    Set fs = CreateObject("Scripting.FileSystemObject") 

    ''Set up the file. 
    ''SpFolder is a small function, but it would be better to fill in a 
    ''path name instead of SpFolder(Desktop), eg "c:\users\somename\desktop" 
    Set f = fs.CreateTextFile(SpFolder(Desktop) & "\" _ 
     & Replace(CurrentProject.Name, ".", "") & ".txt") 

    ''For each component in the project ... 
    For Each mdl In VBE.ActiveVBProject.VBComponents 
     ''using the count of lines ... 
     i = VBE.ActiveVBProject.VBComponents(mdl.Name).CodeModule.CountOfLines 
     ''put the code in a string ... 
     If i > 0 Then 
      strMod = VBE.ActiveVBProject.VBComponents(mdl.Name).codemodule.Lines(1, i) 
     End If 
     ''and then write it to a file, first marking the start with 
     ''some equal signs and the component name. 
     f.writeline String(15, "=") & vbCrLf & mdl.Name _ 
      & vbCrLf & String(15, "=") & vbCrLf & strMod 
    Next 

    ''Close eveything 
    f.Close 
    Set fs = Nothing 
    End Sub 

Чтобы получить специальные папки, вы можете использовать список, предоставленный Microsoft.

Перечисление специальных папок: http://www.microsoft.com/technet/scriptcenter/guide/sas_fil_higv.mspx?mfr=true

От: http://wiki.lessthandot.com/index.php/Code_and_Code_Windows

Answer 2

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

Вы можете написать свой собственный «экспорт всех» эквивалент легко:

Public Sub ExportModules() 
Const cstrExtension As String = ".bas" 
Dim objModule As Object 
Dim strFolder As String 
Dim strDestination As String 

strFolder = CurrentProject.Path 

For Each objModule In CurrentProject.AllModules 
    strDestination = strFolder & Chr(92) & objModule.Name & cstrExtension 
    Application.SaveAsText acModule, objModule.Name, strDestination 
Next objModule 
End Sub 

Answer 3

Вы можете сделать это без необходимости написания какого-либо кода. В меню выберите инструменты-> анализ-> документатор базы данных.

Это даст вам набор параметров для распечатки кода. Затем вы можете просматривать эфир отчета, отправляя его на свой принтер PDF (если он у вас есть). Или просто распечатайте принтер текстового файла. Или вы можете даже щелкнуть по слову в строке меню отчета, и результаты будут отправлены на слово

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

Итак, вместо некоторых предложенных примеров кода вы можете сделать это без необходимости писать какой-либо код вообще. Играйте с дополнительными опциями в документе. Документ будет выдавать ОГРОМНЫЕ тома для распечатки информации для каждого отдельного объекта и объекта в базе данных. Итак, если вы не отмените проверку некоторых параметров, вы легко очистите полноцветный лоток для бумаги. Таким образом, этот документер приводит к огромным распечаткам.

Answer 4

Вот моя версия:

'============================================================' 
' OutputCodeModules for Access 
' Don Jewett, verion 2014.11.10 
' Exports the following items from an Access database 
' Modules 
' Form Modules 
' Report Modules 
' 
' Must be imported into Access database and run from there 
'============================================================' 
Option Explicit 
Option Compare Database 

Private Const KEY_MODULES As String = "Modules" 
Private Const KEY_FORMS As String = "Forms" 
Private Const KEY_REPORTS As String = "Reports" 

Private m_bCancel As Boolean 
Private m_sLogPath As String 

'------------------------------------------------------------' 
' >>>>>> Run this using F5 or F8 <<<<<<<< 
'------------------------------------------------------------' 
Public Sub OutputModuleHelper() 
    OutputModules 
End Sub 

Public Sub OutputModules(Optional ByVal sFolder As String) 
    Dim nCount As Long 
    Dim nSuccessful As Long 
    Dim sLine As String 
    Dim sMessage As String 
    Dim sFile As String 

    If sFolder = "" Then 
     sFolder = Left$(CurrentDb.Name, InStrRev(CurrentDb.Name, "\") - 1) 
     sFolder = InputBox("Enter folder for files", "Output Code", sFolder) 
     If sFolder = "" Then 
      Exit Sub 
     End If 
    End If 

    'normalize root path by removing trailing back-slash 
    If Right(sFolder, 1) = "\" Then 
     sFolder = Left(sFolder, Len(sFolder) - 1) 
    End If 

    'make sure this folder exists 
    If Not isDir(sFolder) Then 
     MsgBox "Folder does not exist", vbExclamation Or vbOKOnly 
     Exit Sub 
    End If 

    'get a new log filename 
    m_sLogPath = sFolder & "\_log-" & Format(Date, "yyyy-MM-dd-nn-mm-ss") & ".txt" 

    sLine = CurrentDb.Name 
    writeLog sLine 
    sMessage = sLine & vbCrLf 

    sLine = Format(Now, "yyyy-MM-dd nn:mm:ss") & vbCrLf 
    writeLog sLine 
    sMessage = sMessage & sLine & vbCrLf 

    'output modules 
    nCount = CurrentDb.Containers(KEY_MODULES).Documents.Count 
    nSuccessful = outputContainerModules(sFolder, KEY_MODULES) 

    'write to the log file and final message 
    sLine = nSuccessful & vbTab & "of" & vbTab & nCount & vbTab & KEY_MODULES & " exported" 
    writeFile m_sLogPath, sLine, True 
    sMessage = sMessage & vbTab & sLine & vbCrLf 

    'output form modules 
    If Not m_bCancel Then 
     nCount = CurrentDb.Containers(KEY_FORMS).Documents.Count 
     nSuccessful = outputContainerModules(sFolder, KEY_FORMS) 

     'write to the log file and final message 
     sLine = nSuccessful & vbTab & "of" & vbTab & nCount & vbTab & "Form Modules exported" 
     writeFile m_sLogPath, sLine, True 
     sMessage = sMessage & vbTab & sLine & vbCrLf 
    End If 

    'output report modules 
    If Not m_bCancel Then 
     nCount = CurrentDb.Containers(KEY_REPORTS).Documents.Count 
     nSuccessful = outputContainerModules(sFolder, KEY_REPORTS) 

     'write to the log file and final message 
     sLine = nSuccessful & vbTab & "of" & vbTab & nCount & vbTab & "Report Modules exported" 
     writeFile m_sLogPath, sLine, True 
     sMessage = sMessage & vbTab & sLine & vbCrLf 
    End If 

    If Len(sMessage) Then 
     MsgBox sMessage, vbInformation Or vbOKOnly, "OutputModules" 
    End If 

End Sub 

Private Function outputContainerModules(_ 
     ByVal sFolder As String, _ 
     ByVal sKey As String) As Long 

    Dim n As Long 
    Dim nCount As Long 
    Dim sName As String 
    Dim sPath As String 

    On Error GoTo EH 

    'refactored this to use reference to Documents, 
    'but the object reference doesn't stick around 
    'and I had to roll back to this which isn't as pretty. 
    'but this works (and if it ain't broke...) 
    For n = 0 To CurrentDb.Containers(sKey).Documents.Count - 1 

     nCount = nCount + 1 
     sName = CurrentDb.Containers(sKey).Documents(n).Name 

     Select Case sKey 
      Case KEY_FORMS 
       sName = "Form_" & sName 
      Case KEY_REPORTS 
       sName = "Report_" & sName 
     End Select 

     sPath = sFolder & "\" & sName & ".txt" 
     DoCmd.OutputTo acOutputModule, sName, acFormatTXT, sPath, False 

    Next 'n 

    outputContainerModules = nCount 

    Exit Function 

EH: 
    nCount = nCount - 1 

    Select Case Err.Number 
     Case 2289 'can't output the module in the requested format. 

      'TODO: research - I think this happens when a Form/Report doesn't have a module 
      Resume Next 

     Case Else 
      Dim sMessage As String 

      writeError Err, sKey, sName, nCount 

      sMessage = "An Error ocurred outputting " & sKey & ": " & sName & vbCrLf & vbCrLf _ 
       & "Number " & Err.Number & vbCrLf _ 
       & "Description:" & Err.Description & vbCrLf & vbCrLf _ 
       & "Click [Yes] to continue with export or [No] to stop." 

      If vbYes = MsgBox(sMessage, vbQuestion Or vbYesNo Or vbDefaultButton2, "Error") Then 
       Resume Next 
      Else 
       m_bCancel = True 
       outputContainerModules = nCount 
      End If 

    End Select 

End Function 

Private Function writeFile(_ 
     ByVal sPath As String, _ 
     ByRef sMessage As String, _ 
     Optional ByVal bAppend As Boolean) As Boolean 

    'Dim oFSO as Object 
    'Dim oStream as Object 
    'Const ForWriting As Long = 2 
    'Const ForAppending As Long = 8 
    'Dim eFlags As Long 
    Dim oFSO As FileSystemObject 
    Dim oStream As TextStream 
    Dim eFlags As IOMode 

    On Error GoTo EH 

    'Set oFSO = Server.CreateObject("Scripting.FileSystemObject") 
    Set oFSO = New FileSystemObject 

    If bAppend Then 
     eFlags = ForAppending 
    Else 
     eFlags = ForWriting 
    End If 

    Set oStream = oFSO.OpenTextFile(sPath, eFlags, True) 
    oStream.WriteLine sMessage 

    writeFile = True 

    GoTo CLEAN 
EH: 
    writeFile = False 

CLEAN: 
    If Not oFSO Is Nothing Then 
     Set oFSO = Nothing 
    End If 
    If Not oStream Is Nothing Then 
     Set oStream = Nothing 
    End If 
End Function 

Private Sub writeError(_ 
    ByRef oErr As ErrObject, _ 
    ByVal sType As String, _ 
    ByVal sName As String, _ 
    ByVal nCount As Long) 

    Dim sMessage As String 

    sMessage = "An Error ocurred outputting " & sType & ": " & sName & " (" & nCount & ")" & vbCrLf _ 
     & "Number " & oErr.Number & vbCrLf _ 
     & "Description:" & oErr.Description & vbCrLf & vbCrLf 

    writeLog sMessage 

End Sub 

Private Sub writeLog(_ 
    ByRef sMessage As String) 

    On Error GoTo EH 

    writeFile m_sLogPath, sMessage & vbCrLf, True 

    Exit Sub 
EH: 
    'swallow errors? 
End Sub 


Private Function isDir(ByVal sPath As String) As Boolean 
    On Error GoTo EH 

    If Right$(sPath, 1) <> "\" Then 
     sPath = sPath & "\" 
    End If 

    If Dir$(sPath & ".", vbDirectory) = "." Then 
     isDir = True 
    ElseIf Len(sPath) = 3 Then 
     If Dir$(sPath, vbVolume) = Left(sPath, 1) Then 
      isDir = True 
     End If 
    End If 

    Exit Function 
EH: 
    isDir = False 
End Function