How do you use version control with Access development?

后端 未结 20 1914
慢半拍i
慢半拍i 2020-11-22 12:55

I\'m involved with updating an Access solution. It has a good amount of VBA, a number of queries, a small amount of tables, and a few forms for data entry & report gene

20条回答
  •  青春惊慌失措
    2020-11-22 13:21

    The answer from Oliver works great. Please find my extended version below that adds support for Access queries.

    (please see answer from Oliver for more information/usage)

    decompose.vbs:

    ' 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
    
    ' 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 <> 0) and (Err.Description <> 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 & "\Source\"
        End If
        sStubADPFilename = sExportpath & myName & "_stub." & myType
    
        WScript.Echo "copy stub to " & sStubADPFilename & "..."
        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 " & sStubADPFilename & " ..."
        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 "  " & myObj.fullname
            oApplication.SaveAsText acForm, myObj.fullname, sExportpath & "\" & myObj.fullname & ".form"
            oApplication.DoCmd.Close acForm, myObj.fullname
            dctDelete.Add "FO" & myObj.fullname, acForm
        Next
        For Each myObj In oApplication.CurrentProject.AllModules
            WScript.Echo "  " & myObj.fullname
            oApplication.SaveAsText acModule, myObj.fullname, sExportpath & "\" & myObj.fullname & ".bas"
            dctDelete.Add "MO" & myObj.fullname, acModule
        Next
        For Each myObj In oApplication.CurrentProject.AllMacros
            WScript.Echo "  " & myObj.fullname
            oApplication.SaveAsText acMacro, myObj.fullname, sExportpath & "\" & myObj.fullname & ".mac"
            dctDelete.Add "MA" & myObj.fullname, acMacro
        Next
        For Each myObj In oApplication.CurrentProject.AllReports
            WScript.Echo "  " & myObj.fullname
            oApplication.SaveAsText acReport, myObj.fullname, sExportpath & "\" & myObj.fullname & ".report"
            dctDelete.Add "RE" & myObj.fullname, acReport
        Next
        For Each myObj In oApplication.CurrentDb.QueryDefs
            if not left(myObj.name,3) = "~sq" then 'exclude queries defined by the forms. Already included in the form itself
                WScript.Echo "  " & myObj.name
                oApplication.SaveAsText acQuery, myObj.name, sExportpath & "\" & myObj.name & ".query"
                oApplication.DoCmd.Close acQuery, myObj.name
                dctDelete.Add "FO" & myObj.name, acQuery
            end if
        Next
    
        WScript.Echo "deleting..."
        dim sObjectname
        For Each sObjectname In dctDelete
            WScript.Echo "  " & Mid(sObjectname, 3)
            oApplication.DoCmd.DeleteObject dctDelete(sObjectname), Mid(sObjectname, 3)
        Next
    
        oApplication.CloseCurrentDatabase
        oApplication.CompactRepair sStubADPFilename, sStubADPFilename & "_"
        oApplication.Quit
    
        fso.CopyFile sStubADPFilename & "_", sStubADPFilename
        fso.DeleteFile sStubADPFilename & "_"
    
    
    End Function
    
    Public Function getErr()
        Dim strError
        strError = vbCrLf & "----------------------------------------------------------------------------------------------------------------------------------------" & vbCrLf & _
                   "From " & Err.source & ":" & vbCrLf & _
                   "    Description: " & Err.Description & vbCrLf & _
                   "    Code: " & Err.Number & vbCrLf
        getErr = strError
    End Function
    

    compose.vbs:

    ' Usage:
    '  WScript compose.vbs  
    
    ' 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 acQuery = 1
    
    Const acCmdCompileAndSaveAllModules = &H7E
    
    ' 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 sPath
    If (WScript.Arguments.Count = 1) then
        sPath = ""
    else
        sPath = WScript.Arguments(1)
    End If
    
    
    importModulesTxt sADPFilename, sPath
    
    If (Err <> 0) and (Err.Description <> 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 & "\Source\"
        End If
        sStubADPFilename = sImportpath & myName & "_stub." & myType
    
        ' check for existing file and ask to overwrite with the stub
        if (fso.FileExists(sADPFilename)) Then
            WScript.StdOut.Write sADPFilename & " existiert bereits. Überschreiben? (j/n) "
            dim sInput
            sInput = WScript.StdIn.Read(1)
            if (sInput <> "j") Then
                WScript.Quit
            end if
    
            fso.CopyFile sADPFilename, sADPFilename & ".bak"
        end if
    
        fso.CopyFile sStubADPFilename, sADPFilename
    
        ' launch MSAccess
        WScript.Echo "starting Access..."
        Dim oApplication
        Set oApplication = CreateObject("Access.Application")
        WScript.Echo "opening " & sADPFilename & " ..."
        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 "  " & objectname & " (" & objecttype & ")"
    
            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
            elseif (objecttype = "query") then
               oApplication.LoadFromText acQuery, objectname, myFile.Path
            end if
    
        next
    
        oApplication.RunCommand acCmdCompileAndSaveAllModules
        oApplication.Quit
    End Function
    
    Public Function getErr()
        Dim strError
        strError = vbCrLf & "----------------------------------------------------------------------------------------------------------------------------------------" & vbCrLf & _
                   "From " & Err.source & ":" & vbCrLf & _
                   "    Description: " & Err.Description & vbCrLf & _
                   "    Code: " & Err.Number & vbCrLf
        getErr = strError
    End Function
    

提交回复
热议问题