从Access 2007到2010的移植无法使用XSD验证XML

我正在针对XSD验证XML。

这是我使用的功能：

Public Function ValidaXML(ByVal strXMLPath As String, _
                          ByVal strXSDPath As String) As Boolean
    Dim objSchemas As MSXML2.XMLSchemaCache40
    Dim objXML As MSXML2.DOMDocument40
    Dim objXSD As MSXML2.DOMDocument40
    Dim strNamespace As String
    Dim objErr As MSXML2.IXMLDOMParseError

    ' load XSD as DOM to populate in Schema Cache
    Set objXSD = New MSXML2.DOMDocument40
    objXSD.async = False
    If Not objXSD.Load(strXSDPath) Then
       Err.Raise 1, "ValidaXML", "Load XSD failed: " & objXSD.parseError.reason
    Else
        ' get namespace name from XSD targetNamespace attribute
        strNamespace = objXSD.documentElement.getAttribute("targetNamespace")
    End If

    ' populate schema cache
    Set objSchemas = New MSXML2.XMLSchemaCache40
    objSchemas.Add strNamespace, objXSD

    ' load XML file (without validation - that comes later)
    Set objXML = New MSXML2.DOMDocument40
    objXML.async = False
    objXML.validateOnParse = False
    objXML.resolveExternals = False

    ' load XML, without any validation
    If Not objXML.Load(strXMLPath) Then
       Err.Raise 1, "ValidaXML", "Load XML failed: " & objXML.parseError.reason
    End If

    ' bind Schema Cache to DOM
    Set objXML.schemas = objSchemas

    ' does this XML measure up?
    Set objErr = objXML.Validate()

    ' any good?
    ValidaXML = (objErr.errorCode = 0)
    If objErr.errorCode <> 0 Then
       Err.Raise 1, "ValidaXML", objErr.reason
    End If
End Function

我使用的指令是：

Private Sub valida_Click()
Call ValidaXML("C:\xq10\q19\recibos.xml", "C:\xq10\xml\pain.008.001.02.xsd")
End Sub

使用Microsoft Access 2007，该功能正常运行。但是，当我使用Access 2010时，第一行出现错误：

Set objXSD = New MSXML2.DOMDocument40

我收到的错误是：

运行时错误“ 429”：ActiveX组件无法创建对象

我非常感谢您可以提供的任何帮助。