VBScript 抛出异常 80010105

VBScipt throws exception 80010105

不幸的是,在我们公司,我们必须在ms access的基础上开发和维护某些程序。我们面临的挑战是将程序放在适当的版本管理系统中。

不幸的是,Access 数据库只是一个包含子文档的文件。

这些可以手动导出,但是内部依赖关系,例如几个外部和内部表的定义视图,很难维护。

在我们的研究过程中,我们发现以下答案是我们问题的一般解决方案

How do you use version control with Access development?

这里描述了一个脚本,它分解访问文件并使其版本化。

脚本副本:

decompose.vbs:

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

    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 acCmdCompileAndSaveAllModules = &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 <> 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 & " exists. Overwrite? (y/n) "
        dim sInput
        sInput = WScript.StdIn.Read(1)
        if (sInput <> "y") 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
        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

( 脚本来自:https://whosebug.com/users/54420/josh-stodola 摘自:How do you use version control with Access development? 在:25.01.2020(DDMMYYYY) )

但是,在这里我们遇到了反汇编报告时脚本崩溃的问题。

(例外 80010105)

我们的问题是否有更好的解决方案,或者是否知道错误发生的原因?

一般来说,您可以导出报告。但是,如果报告有打印机设置,而您没有在计算机上安装该打印机驱动程序,则会发生故障。在这种情况下,您会收到有关缺少打印机的错误消息,并会提示您将打印机更改为默认打印机。

鉴于以上原因,我建议所有报告都默认为“默认”打印机。这只是意味着任何和所有报告都不能指定打印机。然后,您必须向项目添加一些代码以“设置”打印机。因此,也许一个简单的 table 与报告和打印机名称的列使用 could/would 工作。

因此,如果将报告导出到 git-hub 或任何其他源代码控制系统,它们应该可以正常导入。但是,如果报告具有特定的打印机设置并且您的计算机试图从该源代码存储中“构建”访问应用程序,则此过程会中断。

所以为了让这个工作你需要从报告中删除任何打印机设置(它必须是“none”然后在导入(或进入设计模式)时,可以导入这样的报告并在您给定的开发计算机上使用。因此,您需要确保在此过程中永远不会出现关于丢失打印机的“提示”。