Note that there are some explanatory texts on larger screens.

plurals
  1. PO
    primarykey
    data
    text
    <p>We wrote our own script in VBScript, that uses the undocumented Application.SaveAsText() in Access to export all code, form, macro and report modules. Here it is, it should give you some pointers. (Beware: some of the messages are in german, but you can easily change that.)</p> <p>EDIT: To summarize various comments below: <del>Our Project assumes an .adp-file. In order to get this work with .mdb/.accdb, you have to change OpenAccessProject() to OpenCurrentDatabase()</del>. (Updated to use <code>OpenAccessProject()</code> if it sees a .adp extension, else use <code>OpenCurrentDatabase()</code>.)</p> <p>decompose.vbs:</p> <pre class="lang-vb prettyprint-override"><code>' Usage: ' CScript decompose.vbs &lt;input file&gt; &lt;path&gt; ' Converts all modules, classes, forms and macros from an Access Project file (.adp) &lt;input file&gt; to ' text and saves the results in separate files to &lt;path&gt;. Requires Microsoft Access. ' Option Explicit const acForm = 2 const acModule = 5 const acMacro = 4 const acReport = 3 ' BEGIN CODE Dim fso Set fso = CreateObject("Scripting.FileSystemObject") dim sADPFilename If (WScript.Arguments.Count = 0) then MsgBox "Bitte den Dateinamen angeben!", vbExclamation, "Error" Wscript.Quit() End if sADPFilename = fso.GetAbsolutePathName(WScript.Arguments(0)) Dim sExportpath If (WScript.Arguments.Count = 1) then sExportpath = "" else sExportpath = WScript.Arguments(1) End If exportModulesTxt sADPFilename, sExportpath If (Err &lt;&gt; 0) and (Err.Description &lt;&gt; NULL) Then MsgBox Err.Description, vbExclamation, "Error" Err.Clear End If Function exportModulesTxt(sADPFilename, sExportpath) Dim myComponent Dim sModuleType Dim sTempname Dim sOutstring dim myType, myName, myPath, sStubADPFilename myType = fso.GetExtensionName(sADPFilename) myName = fso.GetBaseName(sADPFilename) myPath = fso.GetParentFolderName(sADPFilename) If (sExportpath = "") then sExportpath = myPath &amp; "\Source\" End If sStubADPFilename = sExportpath &amp; myName &amp; "_stub." &amp; myType WScript.Echo "copy stub to " &amp; sStubADPFilename &amp; "..." On Error Resume Next fso.CreateFolder(sExportpath) On Error Goto 0 fso.CopyFile sADPFilename, sStubADPFilename WScript.Echo "starting Access..." Dim oApplication Set oApplication = CreateObject("Access.Application") WScript.Echo "opening " &amp; sStubADPFilename &amp; " ..." If (Right(sStubADPFilename,4) = ".adp") Then oApplication.OpenAccessProject sStubADPFilename Else oApplication.OpenCurrentDatabase sStubADPFilename End If oApplication.Visible = false dim dctDelete Set dctDelete = CreateObject("Scripting.Dictionary") WScript.Echo "exporting..." Dim myObj For Each myObj In oApplication.CurrentProject.AllForms WScript.Echo " " &amp; myObj.fullname oApplication.SaveAsText acForm, myObj.fullname, sExportpath &amp; "\" &amp; myObj.fullname &amp; ".form" oApplication.DoCmd.Close acForm, myObj.fullname dctDelete.Add "FO" &amp; myObj.fullname, acForm Next For Each myObj In oApplication.CurrentProject.AllModules WScript.Echo " " &amp; myObj.fullname oApplication.SaveAsText acModule, myObj.fullname, sExportpath &amp; "\" &amp; myObj.fullname &amp; ".bas" dctDelete.Add "MO" &amp; myObj.fullname, acModule Next For Each myObj In oApplication.CurrentProject.AllMacros WScript.Echo " " &amp; myObj.fullname oApplication.SaveAsText acMacro, myObj.fullname, sExportpath &amp; "\" &amp; myObj.fullname &amp; ".mac" dctDelete.Add "MA" &amp; myObj.fullname, acMacro Next For Each myObj In oApplication.CurrentProject.AllReports WScript.Echo " " &amp; myObj.fullname oApplication.SaveAsText acReport, myObj.fullname, sExportpath &amp; "\" &amp; myObj.fullname &amp; ".report" dctDelete.Add "RE" &amp; myObj.fullname, acReport Next WScript.Echo "deleting..." dim sObjectname For Each sObjectname In dctDelete WScript.Echo " " &amp; Mid(sObjectname, 3) oApplication.DoCmd.DeleteObject dctDelete(sObjectname), Mid(sObjectname, 3) Next oApplication.CloseCurrentDatabase oApplication.CompactRepair sStubADPFilename, sStubADPFilename &amp; "_" oApplication.Quit fso.CopyFile sStubADPFilename &amp; "_", sStubADPFilename fso.DeleteFile sStubADPFilename &amp; "_" End Function Public Function getErr() Dim strError strError = vbCrLf &amp; "----------------------------------------------------------------------------------------------------------------------------------------" &amp; vbCrLf &amp; _ "From " &amp; Err.source &amp; ":" &amp; vbCrLf &amp; _ " Description: " &amp; Err.Description &amp; vbCrLf &amp; _ " Code: " &amp; Err.Number &amp; vbCrLf getErr = strError End Function </code></pre> <p>If you need a clickable Command, instead of using the command line, create a file named "decompose.cmd" with</p> <pre class="lang-vb prettyprint-override"><code>cscript decompose.vbs youraccessapplication.adp </code></pre> <p>By default, all exported files go into a "Scripts" subfolder of your Access-application. The .adp/mdb file is also copied to this location (with a "stub" suffix) and stripped of all the exported modules, making it really small. </p> <p>You MUST checkin this stub with the source-files, because most access settings and custom menu-bars cannot be exported any other way. Just be sure to commit changes to this file only, if you really changed some setting or menu.</p> <p>Note: If you have any Autoexec-Makros defined in your Application, you may have to hold the Shift-key when you invoke the decompose to prevent it from executing and interfering with the export!</p> <p>Of course, there is also the reverse script, to build the Application from the "Source"-Directory:</p> <p>compose.vbs:</p> <pre class="lang-vb prettyprint-override"><code>' Usage: ' WScript compose.vbs &lt;file&gt; &lt;path&gt; ' Converts all modules, classes, forms and macros in a directory created by "decompose.vbs" ' and composes then into an Access Project file (.adp). This overwrites any existing Modules with the ' same names without warning!!! ' Requires Microsoft Access. Option Explicit const acForm = 2 const acModule = 5 const acMacro = 4 const acReport = 3 Const acCmdCompileAndSaveAllModules = &amp;H7E ' BEGIN CODE Dim fso Set fso = CreateObject("Scripting.FileSystemObject") dim sADPFilename If (WScript.Arguments.Count = 0) then MsgBox "Please enter the file name!", vbExclamation, "Error" Wscript.Quit() End if sADPFilename = fso.GetAbsolutePathName(WScript.Arguments(0)) Dim sPath If (WScript.Arguments.Count = 1) then sPath = "" else sPath = WScript.Arguments(1) End If importModulesTxt sADPFilename, sPath If (Err &lt;&gt; 0) and (Err.Description &lt;&gt; NULL) Then MsgBox Err.Description, vbExclamation, "Error" Err.Clear End If Function importModulesTxt(sADPFilename, sImportpath) Dim myComponent Dim sModuleType Dim sTempname Dim sOutstring ' Build file and pathnames dim myType, myName, myPath, sStubADPFilename myType = fso.GetExtensionName(sADPFilename) myName = fso.GetBaseName(sADPFilename) myPath = fso.GetParentFolderName(sADPFilename) ' if no path was given as argument, use a relative directory If (sImportpath = "") then sImportpath = myPath &amp; "\Source\" End If sStubADPFilename = sImportpath &amp; myName &amp; "_stub." &amp; myType ' check for existing file and ask to overwrite with the stub if (fso.FileExists(sADPFilename)) Then WScript.StdOut.Write sADPFilename &amp; " exists. Overwrite? (y/n) " dim sInput sInput = WScript.StdIn.Read(1) if (sInput &lt;&gt; "y") Then WScript.Quit end if fso.CopyFile sADPFilename, sADPFilename &amp; ".bak" end if fso.CopyFile sStubADPFilename, sADPFilename ' launch MSAccess WScript.Echo "starting Access..." Dim oApplication Set oApplication = CreateObject("Access.Application") WScript.Echo "opening " &amp; sADPFilename &amp; " ..." If (Right(sStubADPFilename,4) = ".adp") Then oApplication.OpenAccessProject sADPFilename Else oApplication.OpenCurrentDatabase sADPFilename End If oApplication.Visible = false Dim folder Set folder = fso.GetFolder(sImportpath) ' load each file from the import path into the stub Dim myFile, objectname, objecttype for each myFile in folder.Files objecttype = fso.GetExtensionName(myFile.Name) objectname = fso.GetBaseName(myFile.Name) WScript.Echo " " &amp; objectname &amp; " (" &amp; objecttype &amp; ")" if (objecttype = "form") then oApplication.LoadFromText acForm, objectname, myFile.Path elseif (objecttype = "bas") then oApplication.LoadFromText acModule, objectname, myFile.Path elseif (objecttype = "mac") then oApplication.LoadFromText acMacro, objectname, myFile.Path elseif (objecttype = "report") then oApplication.LoadFromText acReport, objectname, myFile.Path end if next oApplication.RunCommand acCmdCompileAndSaveAllModules oApplication.Quit End Function Public Function getErr() Dim strError strError = vbCrLf &amp; "----------------------------------------------------------------------------------------------------------------------------------------" &amp; vbCrLf &amp; _ "From " &amp; Err.source &amp; ":" &amp; vbCrLf &amp; _ " Description: " &amp; Err.Description &amp; vbCrLf &amp; _ " Code: " &amp; Err.Number &amp; vbCrLf getErr = strError End Function </code></pre> <p>Again, this goes with a companion "compose.cmd" containing:</p> <pre class="lang-vb prettyprint-override"><code>cscript compose.vbs youraccessapplication.adp </code></pre> <p>It asks you to confirm overwriting your current application and first creates a backup, if you do. It then collects all source-files in the Source-Directory and re-inserts them into the stub.</p> <p>Have Fun!</p>
    singulars
    1. This table or related slice is empty.
    plurals
    1. This table or related slice is empty.
    1. This table or related slice is empty.
    1. This table or related slice is empty.
    1. VO
      singulars
      1. This table or related slice is empty.
    2. VO
      singulars
      1. This table or related slice is empty.
    3. VO
      singulars
      1. This table or related slice is empty.
 

Querying!

 
Guidance

SQuiL has stopped working due to an internal error.

If you are curious you may find further information in the browser console, which is accessible through the devtools (F12).

Reload