How do you use version control with Access development?

后端 未结 20 1717
慢半拍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 <input file> <path>
    
    ' Converts all modules, classes, forms and macros from an Access Project file (.adp) <input file> to
    ' text and saves the results in separate files to <path>.  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 <file> <path>
    
    ' 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
    
    0 讨论(0)
  • 2020-11-22 13:23

    For anyone stuck with Access 97, I was not able to get the other answers to work. Using a combination of Oliver's and DaveParillo's excellent answers and making some modifications, I was able to get the scripts working with our Access 97 databases. It's also a bit more user-friendly since it asks which folder to place the files.

    AccessExport.vbs:

    ' Converts all modules, classes, forms and macros from an Access file (.mdb) <input file> to
    ' text and saves the results in separate files to <path>.  Requires Microsoft Access.
    Option Explicit
    
    Const acQuery = 1
    Const acForm = 2
    Const acModule = 5
    Const acMacro = 4
    Const acReport = 3
    Const acCmdCompactDatabase = 4
    Const TemporaryFolder = 2
    
    Dim strMDBFileName : strMDBFileName = SelectDatabaseFile
    Dim strExportPath : strExportPath = SelectExportFolder
    CreateExportFolders(strExportPath)
    Dim objProgressWindow
    Dim strOverallProgress
    CreateProgressWindow objProgressWindow
    Dim strTempMDBFileName
    CopyToTempDatabase strMDBFileName, strTempMDBFileName, strOverallProgress
    Dim objAccess
    Dim objDatabase
    OpenAccessDatabase objAccess, objDatabase, strTempMDBFileName, strOverallProgress
    ExportQueries objAccess, objDatabase, objProgressWindow, strExportPath, strOverallProgress
    ExportForms objAccess, objDatabase, objProgressWindow, strExportPath, strOverallProgress
    ExportReports objAccess, objDatabase, objProgressWindow, strExportPath, strOverallProgress
    ExportMacros objAccess, objDatabase, objProgressWindow, strExportPath, strOverallProgress
    ExportModules objAccess, objDatabase, objProgressWindow, strExportPath, strOverallProgress
    objAccess.CloseCurrentDatabase
    objAccess.Quit
    DeleteTempDatabase strTempMDBFileName, strOverallProgress
    objProgressWindow.Quit
    MsgBox "Successfully exported database."
    
    Private Function SelectDatabaseFile()
        MsgBox "Please select the Access database to export."
        Dim objFileOpen : Set objFileOpen = CreateObject("SAFRCFileDlg.FileOpen")
        If objFileOpen.OpenFileOpenDlg Then
            SelectDatabaseFile = objFileOpen.FileName
        Else
            WScript.Quit()
        End If
    End Function
    
    Private Function SelectExportFolder()
        Dim objShell : Set objShell = CreateObject("Shell.Application")
        SelectExportFolder = objShell.BrowseForFolder(0, "Select folder to export the database to:", 0, "").self.path & "\"
    End Function
    
    Private Sub CreateExportFolders(strExportPath)
        Dim objFileSystem : Set objFileSystem = CreateObject("Scripting.FileSystemObject")
        MsgBox "Existing folders from a previous Access export under " & strExportPath & " will be deleted!"
        If objFileSystem.FolderExists(strExportPath & "Queries\") Then
            objFileSystem.DeleteFolder strExportPath & "Queries", true
        End If
        objFileSystem.CreateFolder(strExportPath & "Queries\")
        If objFileSystem.FolderExists(strExportPath & "Forms\") Then
            objFileSystem.DeleteFolder strExportPath & "Forms", true
        End If
        objFileSystem.CreateFolder(strExportPath & "Forms\")
        If objFileSystem.FolderExists(strExportPath & "Reports\") Then
            objFileSystem.DeleteFolder strExportPath & "Reports", true
        End If
        objFileSystem.CreateFolder(strExportPath & "Reports\")
        If objFileSystem.FolderExists(strExportPath & "Macros\") Then
            objFileSystem.DeleteFolder strExportPath & "Macros", true
        End If
        objFileSystem.CreateFolder(strExportPath & "Macros\")
        If objFileSystem.FolderExists(strExportPath & "Modules\") Then
            objFileSystem.DeleteFolder strExportPath & "Modules", true
        End If
        objFileSystem.CreateFolder(strExportPath & "Modules\")
    End Sub
    
    Private Sub CreateProgressWindow(objProgressWindow)
        Set objProgressWindow = CreateObject ("InternetExplorer.Application")
        objProgressWindow.Navigate "about:blank"
        objProgressWindow.ToolBar = 0
        objProgressWindow.StatusBar = 0
        objProgressWindow.Width = 320
        objProgressWindow.Height = 240
        objProgressWindow.Visible = 1
        objProgressWindow.Document.Title = "Access export in progress"
    End Sub
    
    Private Sub CopyToTempDatabase(strMDBFileName, strTempMDBFileName, strOverallProgress)
        strOverallProgress = strOverallProgress & "Copying to temporary database...<br/>"
        Dim objFileSystem : Set objFileSystem = CreateObject("Scripting.FileSystemObject")
        strTempMDBFileName = objFileSystem.GetSpecialFolder(TemporaryFolder) & "\" & objFileSystem.GetBaseName(strMDBFileName) & "_temp.mdb"
        objFileSystem.CopyFile strMDBFileName, strTempMDBFileName
    End Sub
    
    Private Sub OpenAccessDatabase(objAccess, objDatabase, strTempMDBFileName, strOverallProgress)
        strOverallProgress = strOverallProgress & "Compacting temporary database...<br/>"
        Set objAccess = CreateObject("Access.Application")
        objAccess.Visible = false
        CompactAccessDatabase objAccess, strTempMDBFileName
        strOverallProgress = strOverallProgress & "Opening temporary database...<br/>"
        objAccess.OpenCurrentDatabase strTempMDBFileName
        Set objDatabase = objAccess.CurrentDb
    End Sub
    
    ' Sometimes the Compact Database command errors out, and it's not serious if the database isn't compacted first.
    Private Sub CompactAccessDatabase(objAccess, strTempMDBFileName)
        On Error Resume Next
        Dim objFileSystem : Set objFileSystem = CreateObject("Scripting.FileSystemObject")
        objAccess.DbEngine.CompactDatabase strTempMDBFileName, strTempMDBFileName & "_"
        objFileSystem.CopyFile strTempMDBFileName & "_", strTempMDBFileName
        objFileSystem.DeleteFile strTempMDBFileName & "_"
    End Sub
    
    Private Sub ExportQueries(objAccess, objDatabase, objProgressWindow, strExportPath, strOverallProgress)
        strOverallProgress = strOverallProgress & "Exporting Queries (Step 1 of 5)...<br/>"
        Dim counter
        For counter = 0 To objDatabase.QueryDefs.Count - 1
            objProgressWindow.Document.Body.InnerHTML = strOverallProgress & counter + 1 & " of " & objDatabase.QueryDefs.Count
            objAccess.SaveAsText acQuery, objDatabase.QueryDefs(counter).Name, strExportPath & "Queries\" & Clean(objDatabase.QueryDefs(counter).Name) & ".sql"
        Next
    End Sub
    
    Private Sub ExportForms(objAccess, objDatabase, objProgressWindow, strExportPath, strOverallProgress)
        strOverallProgress = strOverallProgress & "Exporting Forms (Step 2 of 5)...<br/>"
        Dim counter : counter = 1
        Dim objContainer : Set objContainer = objDatabase.Containers("Forms")
        Dim objDocument
        For Each objDocument In objContainer.Documents
            objProgressWindow.Document.Body.InnerHTML = strOverallProgress & counter & " of " & objContainer.Documents.Count
            counter = counter + 1
            objAccess.SaveAsText acForm, objDocument.Name, strExportPath & "Forms\" & Clean(objDocument.Name) & ".form"
            objAccess.DoCmd.Close acForm, objDocument.Name
        Next
    End Sub
    
    Private Sub ExportReports(objAccess, objDatabase, objProgressWindow, strExportPath, strOverallProgress)
        strOverallProgress = strOverallProgress & "Exporting Reports (Step 3 of 5)...<br/>"
        Dim counter : counter = 1
        Dim objContainer : Set objContainer = objDatabase.Containers("Reports")
        Dim objDocument
        For Each objDocument In objContainer.Documents
            objProgressWindow.Document.Body.InnerHTML = strOverallProgress & counter & " of " & objContainer.Documents.Count
            counter = counter + 1
            objAccess.SaveAsText acReport, objDocument.Name, strExportPath & "Reports\" & Clean(objDocument.Name) & ".report"
        Next
    End Sub
    
    Private Sub ExportMacros(objAccess, objDatabase, objProgressWindow, strExportPath, strOverallProgress)
        strOverallProgress = strOverallProgress & "Exporting Macros (Step 4 of 5)...<br/>"
        Dim counter : counter = 1
        Dim objContainer : Set objContainer = objDatabase.Containers("Scripts")
        Dim objDocument
        For Each objDocument In objContainer.Documents
            objProgressWindow.Document.Body.InnerHTML = strOverallProgress & counter & " of " & objContainer.Documents.Count
            counter = counter + 1
            objAccess.SaveAsText acMacro, objDocument.Name, strExportPath & "Macros\" & Clean(objDocument.Name) & ".macro"
        Next
    End Sub
    
    Private Sub ExportModules(objAccess, objDatabase, objProgressWindow, strExportPath, strOverallProgress)
        strOverallProgress = strOverallProgress & "Exporting Modules (Step 5 of 5)...<br/>"
        Dim counter : counter = 1
        Dim objContainer : Set objContainer = objDatabase.Containers("Modules")
        Dim objDocument
        For Each objDocument In objContainer.Documents
            objProgressWindow.Document.Body.InnerHTML = strOverallProgress & counter & " of " & objContainer.Documents.Count
            counter = counter + 1
            objAccess.SaveAsText acModule, objDocument.Name, strExportPath & "Modules\" & Clean(objDocument.Name) & ".module"
        Next
    End Sub
    
    Private Sub DeleteTempDatabase(strTempMDBFileName, strOverallProgress)
        On Error Resume Next
        strOverallProgress = strOverallProgress & "Deleting temporary database...<br/>"
        Dim objFileSystem : Set objFileSystem = CreateObject("Scripting.FileSystemObject")
        objFileSystem.DeleteFile strTempMDBFileName, true
    End Sub
    
    ' Windows doesn't like certain characters, so we have to filter those out of the name when exporting
    Private Function Clean(strInput)
        Dim objRegexp : Set objRegexp = New RegExp
        objRegexp.IgnoreCase = True
        objRegexp.Global = True
        objRegexp.Pattern = "[\\/:*?""<>|]"
        Dim strOutput
        If objRegexp.Test(strInput) Then
            strOutput = objRegexp.Replace(strInput, "")
            MsgBox strInput & " is being exported as " & strOutput
        Else
            strOutput = strInput
        End If
        Clean = strOutput
    End Function
    

    And for importing files into the database, should you need to recreate the database from scratch or you wish to modify files outside of Access for some reason.

    AccessImport.vbs:

    ' Imports all of the queries, forms, reports, macros, and modules from text
    ' files to an Access file (.mdb).  Requires Microsoft Access.
    Option Explicit
    
    const acQuery = 1
    const acForm = 2
    const acModule = 5
    const acMacro = 4
    const acReport = 3
    const acCmdCompileAndSaveAllModules = &H7E
    
    Dim strMDBFilename : strMDBFilename = SelectDatabaseFile
    CreateBackup strMDBFilename
    Dim strImportPath : strImportPath = SelectImportFolder
    Dim objAccess
    Dim objDatabase
    OpenAccessDatabase objAccess, objDatabase, strMDBFilename
    Dim objProgressWindow
    Dim strOverallProgress
    CreateProgressWindow objProgressWindow
    ImportQueries objAccess, objDatabase, objProgressWindow, strImportPath, strOverallProgress
    ImportForms objAccess, objDatabase, objProgressWindow, strImportPath, strOverallProgress
    ImportReports objAccess, objDatabase, objProgressWindow, strImportPath, strOverallProgress
    ImportMacros objAccess, objDatabase, objProgressWindow, strImportPath, strOverallProgress
    ImportModules objAccess, objDatabase, objProgressWindow, strImportPath, strOverallProgress
    objAccess.CloseCurrentDatabase
    objAccess.Quit
    objProgressWindow.Quit
    MsgBox "Successfully imported objects into the database."
    
    Private Function SelectDatabaseFile()
        MsgBox "Please select the Access database to import the objects from.  ALL EXISTING OBJECTS WITH THE SAME NAME WILL BE OVERWRITTEN!"
        Dim objFileOpen : Set objFileOpen = CreateObject( "SAFRCFileDlg.FileOpen" )
        If objFileOpen.OpenFileOpenDlg Then
            SelectDatabaseFile = objFileOpen.FileName
        Else
            WScript.Quit()
        End If
    End Function
    
    Private Function SelectImportFolder()
        Dim objShell : Set objShell = WScript.CreateObject("Shell.Application")
        SelectImportFolder = objShell.BrowseForFolder(0, "Select folder to import the database objects from:", 0, "").self.path & "\"
    End Function
    
    Private Sub CreateBackup(strMDBFilename)
        Dim objFileSystem : Set objFileSystem = CreateObject("Scripting.FileSystemObject")
        objFileSystem.CopyFile strMDBFilename, strMDBFilename & ".bak"
    End Sub
    
    Private Sub OpenAccessDatabase(objAccess, objDatabase, strMDBFileName)
        Set objAccess = CreateObject("Access.Application")
        objAccess.OpenCurrentDatabase strMDBFilename
        objAccess.Visible = false
        Set objDatabase = objAccess.CurrentDb
    End Sub
    
    Private Sub CreateProgressWindow(ByRef objProgressWindow)
        Set objProgressWindow = CreateObject ("InternetExplorer.Application")
        objProgressWindow.Navigate "about:blank"
        objProgressWindow.ToolBar = 0
        objProgressWindow.StatusBar = 0
        objProgressWindow.Width = 320
        objProgressWindow.Height = 240
        objProgressWindow.Visible = 1
        objProgressWindow.Document.Title = "Access import in progress"
    End Sub
    
    Private Sub ImportQueries(objAccess, objDatabase, objProgressWindow, strImportPath, strOverallProgress)
        strOverallProgress = "Importing Queries (Step 1 of 5)...<br/>"
        Dim counter : counter = 0
        Dim folder : Set folder = objFileSystem.GetFolder(strImportPath & "Queries\")
        Dim objFileSystem : Set objFileSystem = CreateObject("Scripting.FileSystemObject")
        Dim file
        Dim strQueryName
        For Each file in folder.Files
            objProgressWindow.Document.Body.InnerHTML = strOverallProgress & counter + 1 & " of " & folder.Files.Count
            strQueryName = objFileSystem.GetBaseName(file.Name)
            objAccess.LoadFromText acQuery, strQueryName, file.Path
            counter = counter + 1
        Next
    End Sub
    
    Private Sub ImportForms(objAccess, objDatabase, objProgressWindow, strImportPath, strOverallProgress)
        strOverallProgress = strOverallProgress & "Importing Forms (Step 2 of 5)...<br/>"
        Dim counter : counter = 0
        Dim folder : Set folder = objFileSystem.GetFolder(strImportPath & "Forms\")
        Dim objFileSystem : Set objFileSystem = CreateObject("Scripting.FileSystemObject")
        Dim file
        Dim strFormName
        For Each file in folder.Files
            objProgressWindow.Document.Body.InnerHTML = strOverallProgress & counter + 1 & " of " & folder.Files.Count
            strFormName = objFileSystem.GetBaseName(file.Name)
            objAccess.LoadFromText acForm, strFormName, file.Path
            counter = counter + 1
        Next
    End Sub
    
    Private Sub ImportReports(objAccess, objDatabase, objProgressWindow, strImportPath, strOverallProgress)
        strOverallProgress = strOverallProgress & "Importing Reports (Step 3 of 5)...<br/>"
        Dim counter : counter = 0
        Dim folder : Set folder = objFileSystem.GetFolder(strImportPath & "Reports\")
        Dim objFileSystem : Set objFileSystem = CreateObject("Scripting.FileSystemObject")
        Dim file
        Dim strReportName
        For Each file in folder.Files
            objProgressWindow.Document.Body.InnerHTML = strOverallProgress & counter + 1 & " of " & folder.Files.Count
            strReportName = objFileSystem.GetBaseName(file.Name)
            objAccess.LoadFromText acReport, strReportName, file.Path
            counter = counter + 1
        Next
    End Sub
    
    Private Sub ImportMacros(objAccess, objDatabase, objProgressWindow, strImportPath, strOverallProgress)
        strOverallProgress = strOverallProgress & "Importing Macros (Step 4 of 5)...<br/>"
        Dim counter : counter = 0
        Dim folder : Set folder = objFileSystem.GetFolder(strImportPath & "Macros\")
        Dim objFileSystem : Set objFileSystem = CreateObject("Scripting.FileSystemObject")
        Dim file
        Dim strMacroName
        For Each file in folder.Files
            objProgressWindow.Document.Body.InnerHTML = strOverallProgress & counter + 1 & " of " & folder.Files.Count
            strMacroName = objFileSystem.GetBaseName(file.Name)
            objAccess.LoadFromText acMacro, strMacroName, file.Path
            counter = counter + 1
        Next
    End Sub
    
    Private Sub ImportModules(objAccess, objDatabase, objProgressWindow, strImportPath, strOverallProgress)
        strOverallProgress = strOverallProgress & "Importing Modules (Step 5 of 5)...<br/>"
        Dim counter : counter = 0
        Dim folder : Set folder = objFileSystem.GetFolder(strImportPath & "Modules\")
        Dim objFileSystem : Set objFileSystem = CreateObject("Scripting.FileSystemObject")
        Dim file
        Dim strModuleName
        For Each file in folder.Files
            objProgressWindow.Document.Body.InnerHTML = strOverallProgress & counter + 1 & " of " & folder.Files.Count
            strModuleName = objFileSystem.GetBaseName(file.Name)
            objAccess.LoadFromText acModule, strModuleName, file.Path
            counter = counter + 1
        Next
    
        ' We need to compile the database whenever any module code changes.
        If Not objAccess.IsCompiled Then
            objAccess.RunCommand acCmdCompileAndSaveAllModules
        End If
    End Sub
    
    0 讨论(0)
提交回复
热议问题