From 20ec2888268ea59c71ecf4810dfef84f066c0f48 Mon Sep 17 00:00:00 2001 From: Lukas Ziegler Date: Sat, 6 Mar 2021 13:27:41 +0000 Subject: [PATCH] =?UTF-8?q?=E2=80=9Edecompose.vbs=E2=80=9C=20hinzuf=C3=BCg?= =?UTF-8?q?en?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- decompose.vbs | 149 ++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 149 insertions(+) create mode 100644 decompose.vbs diff --git a/decompose.vbs b/decompose.vbs new file mode 100644 index 0000000..f7b6c89 --- /dev/null +++ b/decompose.vbs @@ -0,0 +1,149 @@ +' Usage: +' cscript decompose.vbs + +' Converts all modules, classes, forms and macros from an Access Project file (.adp) to +' text and saves the results in separate files to . Requires Microsoft Access. +Option Explicit + +Const acForm = 2 +Const acModule = 5 +Const acMacro = 4 +Const acReport = 3 +Const acQuery = 1 +Const acExportTable = 0 + +' BEGIN CODE +Dim fso, relDoc, ACCDBFilename, sExportpath +Set fso = CreateObject("Scripting.FileSystemObject") +Set relDoc = CreateObject("Microsoft.XMLDOM") + +If (Wscript.Arguments.Count = 0) Then + MsgBox "Please provide the .accdb database file", vbExclamation, "Error" + Wscript.Quit() +End If +ACCDBFilename = fso.GetAbsolutePathName(Wscript.Arguments(0)) + +If (Wscript.Arguments.Count = 1) Then + sExportpath = "" +Else + sExportpath = Wscript.Arguments(1) +End If + + +exportModulesTxt ACCDBFilename, sExportpath + +If (Err <> 0) And (Err.Description <> Null) Then + MsgBox Err.Description, vbExclamation, "Error" + Err.Clear +End If + +Function exportModulesTxt(ACCDBFilename, sExportpath) + Dim myComponent, sModuleType, sTempname, sOutstring + Dim myType, myName, myPath, hasRelations + myType = fso.GetExtensionName(ACCDBFilename) + myName = fso.GetBaseName(ACCDBFilename) + myPath = fso.GetParentFolderName(ACCDBFilename) + + 'if no path was given as argument, use a relative directory + If (sExportpath = "") Then + sExportpath = myPath & "\Source" + End If + 'On Error Resume Next + fso.DeleteFolder (sExportpath) + fso.CreateFolder (sExportpath) + On Error GoTo 0 + + Wscript.Echo "starting Access..." + Dim oApplication + Set oApplication = CreateObject("Access.Application") + Wscript.Echo "Opening " & ACCDBFilename & " ..." + If (Right(ACCDBFilename, 4) = ".adp") Then + oApplication.OpenAccessProject ACCDBFilename + Else + oApplication.OpenCurrentDatabase ACCDBFilename + End If + oApplication.Visible = False + + Wscript.Echo "exporting..." + Dim myObj + For Each myObj In oApplication.CurrentProject.AllForms + Wscript.Echo "Exporting FORM " & myObj.FullName + oApplication.SaveAsText acForm, myObj.FullName, sExportpath & "\" & myObj.FullName & ".form.txt" + oApplication.DoCmd.Close acForm, myObj.FullName + Next + For Each myObj In oApplication.CurrentProject.AllModules + Wscript.Echo "Exporting MODULE " & myObj.FullName + oApplication.SaveAsText acModule, myObj.FullName, sExportpath & "\" & myObj.FullName & ".module.txt" + Next + For Each myObj In oApplication.CurrentProject.AllMacros + Wscript.Echo "Exporting MACRO " & myObj.FullName + oApplication.SaveAsText acMacro, myObj.FullName, sExportpath & "\" & myObj.FullName & ".macro.txt" + Next + For Each myObj In oApplication.CurrentProject.AllReports + Wscript.Echo "Exporting REPORT " & myObj.FullName + oApplication.SaveAsText acReport, myObj.FullName, sExportpath & "\" & myObj.FullName & ".report.txt" + Next + For Each myObj In oApplication.CurrentDb.QueryDefs + Wscript.Echo "Exporting QUERY " & myObj.Name + oApplication.SaveAsText acQuery, myObj.Name, sExportpath & "\" & myObj.Name & ".query.txt" + Next + For Each myObj In oApplication.CurrentDb.TableDefs + If Not Left(myObj.Name, 4) = "MSys" Then + Wscript.Echo "Exporting TABLE " & myObj.Name + oApplication.ExportXml acExportTable, myObj.Name, , sExportpath & "\" & myObj.Name & ".table.txt" + 'put the file path as a second parameter if you want to export the table data as well, instead of ommiting it and passing it into a third parameter for structure only + End If + Next + + hasRelations = False + relDoc.appendChild relDoc.createElement("Relations") + For Each myObj In oApplication.CurrentDb.Relations 'loop though all the relations + If Not Left(myObj.Name, 4) = "MSys" Then + Dim relName, relAttrib, relTable, relFoTable, fld + hasRelations = True + + relDoc.ChildNodes(0).appendChild relDoc.createElement("Relation") + Set relName = relDoc.createElement("Name") + relName.Text = myObj.Name + relDoc.ChildNodes(0).LastChild.appendChild relName + + Set relAttrib = relDoc.createElement("Attributes") + relAttrib.Text = myObj.Attributes + relDoc.ChildNodes(0).LastChild.appendChild relAttrib + + Set relTable = relDoc.createElement("Table") + relTable.Text = myObj.Table + relDoc.ChildNodes(0).LastChild.appendChild relTable + + Set relFoTable = relDoc.createElement("ForeignTable") + relFoTable.Text = myObj.ForeignTable + relDoc.ChildNodes(0).LastChild.appendChild relFoTable + + Wscript.Echo "Exporting relation " & myObj.Name & " between tables " & myObj.Table & " -> " & myObj.ForeignTable + + For Each fld In myObj.Fields 'in case the relationship works with more fields + Dim lf, ff + relDoc.ChildNodes(0).LastChild.appendChild relDoc.createElement("Field") + + Set lf = relDoc.createElement("Name") + lf.Text = fld.Name + relDoc.ChildNodes(0).LastChild.LastChild.appendChild lf + + Set ff = relDoc.createElement("ForeignName") + ff.Text = fld.ForeignName + relDoc.ChildNodes(0).LastChild.LastChild.appendChild ff + + Wscript.Echo " Involving fields " & fld.Name & " -> " & fld.ForeignName + Next + End If + Next + If hasRelations Then + relDoc.InsertBefore relDoc.createProcessingInstruction("xml", "version='1.0'"), relDoc.ChildNodes(0) + relDoc.Save sExportpath & "\relations.rel.txt" + Wscript.Echo "Relations successfuly saved in file relations.rel.txt" + End If + + oApplication.CloseCurrentDatabase + oApplication.Quit + +End Function \ No newline at end of file