Question

我想验证一个xml文件。我不知道如何正确引用xsd。它为“Set xmlDoc.schemas = strXSDFile”行说“需要对象”。

Function CheckXML()

Dim strFileName As String
Dim strXSDFile As String


    strFileName = "C:\mylocation\xmlfile.txt"

    strXSDFile = "C:\mylocation\xsdfile.xsd"


    Set xmlDoc = LoadXmlFile(strFileName)
    Set xmlDoc.schemas = strXSDFile
    Set objErr = xmlDoc.validate()


    If objErr.errorCode = 0 Then
        Debug.Print "No errors found"
    Else
        Debug.Print "Error parser: " & objErr.errorCode & "; " & objErr.reason
    End If

End Function

Function LoadXmlFile(Path As String) As MSXML2.DOMDocument60
    Set LoadXmlFile = New MSXML2.DOMDocument60

    With LoadXmlFile
        .async = False
        .validateOnParse = False
        .resolveExternals = False
        .Load Path
    End With
End Function

Answer 1

在加载XML文档之前，请添加架构。您可以将两者合并为一个功能，如下所示。我使用了消息框，因此我可以格式化文本，但您可以将问题提升为VBA错误。

Public Function LoadAndValidateXML(strXMLPath As String, strXSDPath As String) As MSXML2.DOMDocument60
    Dim xmldom As MSXML2.DOMDocument60
    Set xmldom = New MSXML2.DOMDocument60

    Dim xmlschema As MSXML2.XMLSchemaCache60
    Set xmlschema = New MSXML2.XMLSchemaCache60
    xmlschema.Add "", strXSDPath

    Set xmldom.schemas = xmlschema
    xmldom.async = False
    xmldom.Load strXMLPath

    If xmldom.parseError.errorCode <> 0 Then
        MsgBox "Validation Error: " & xmldom.parseError.errorCode & " " & TrimWhiteSpace(xmldom.parseError.reason)
        MsgBox xmldom.parseError.srcText
    Else
        Set LoadAndValidateXML = xmldom
    End If
End Function

Public Function TrimWhiteSpace(strString As String) As String
    Dim a As Integer
    Dim b As Integer

    For a = 1 To Len(strString)
        Select Case Mid(strString, a, 1)
            Case vbCr, vbLf, vbTab, " ":
                a = a + 1
            Case Else:
                Exit For
        End Select
    Next

    For b = Len(strString) To 1 Step -1
        Select Case Mid(strString, a, 1)
            Case vbCr, vbLf, vbTab, " ":
                b = b + 1
            Case Else:
                Exit For
        End Select
    Next

    TrimWhiteSpace = Mid(strString, a, b - a)
End Function

在MS Access中使用XSD验证XML

1 个答案: