Dim FSO, lText
Set FSO = CreateObject("Scripting.FileSystemObject")
Const ForReading = 1
lText = FSO.OpenTextFile(filename, ForReading).ReadAll
content = GetXmlResult(lText, "Документ", "ИдДок" )
content1 = GetXmlResult(lText, "Документ", "НомСооб" )
content2 = GetXmlResult(lText, "Документ", "ДатаСооб" )
content3 = GetXmlResult(lText, "СвСчет" , "НомСч" )
content4 = GetXmlResult(lText, "Файл" , "ИдФайл" )
content5 = GetXmlResult(lText, "Документ", "ИдФайлИсх" )
content6 = GetXmlResult(lText, "Документ", "ДатаОбр" )
content7 = GetXmlResult(lText, "Документ", "КодОбр" )
content8 = GetXmlResult(lText, "Документ", "РезОбр" )
content9 = GetXmlResult(lText, "Ошибки" , "КодОшибки" )
content10 = GetXmlResult(lText, "Ошибки" , "НаимОшибки")
content11 = GetXmlResult(lText, "Документ", "ТипСооб" )
content12 = trim(_
GetXmlResult2(lText, "СвНП" , "ФИОФЛ", "Фамилия" ) & " " &_
GetXmlResult2(lText, "СвНП" , "ФИОФЛ", "Имя" ) & " " &_
GetXmlResult2(lText, "СвНП" , "ФИОФЛ", "Отчество") & " " &_
GetXmlResult2(lText, "НПИП" , "ФИОИП", "Фамилия" ) & " " &_
GetXmlResult2(lText, "НПИП" , "ФИОИП", "Имя" ) & " " &_
GetXmlResult2(lText, "НПИП" , "ФИОИП", "Отчество") & " " &_
replace(GetXmlResult2(lText, "СвНП", "НПРО", "НаимОрг"), """, """") & " " &_
replace(GetXmlResult2(lText, "СвНП", "НПИО", "НаимОрг"), """, """"))
Set FSO = Nothing
Function GetXmlResult(pText, pTag1, pTag2)
GetXmlResult = ""
On Error Resume Next
GetXmlResult = GetXMLValue(pText, pTag1, pTag2)
If Err.Number <> 0 Then GetXmlResult = ""
On Error GoTo 0
End Function
' Получить значение из XML
Function GetXMLValue(byVal pText, pParentTag, pTag)
Dim REx
Set REx = New RegExp
REx.Global = True
REx.IgnoreCase = True
REx.Pattern = "< *" & pParentTag & "[\r ][^>]*" & pTag & " *= *""([^>=]+) *""[\r >]"
If REx.Test(pText) Then GetXMLValue = REx.Execute(pText)(0).SubMatches(0)
End Function
Function GetXmlResult2(pText, pTag1, pTag2, pTag3)
GetXmlResult2 = ""
On Error Resume Next
GetXmlResult2 = GetXMLValue2(pText, pTag1, pTag2, pTag3)
If Err.Number <> 0 Then GetXmlResult2 = ""
On Error GoTo 0
End Function
' Получить значение из XML 2
Function GetXMLValue2(byVal pText, pParentTag1, pParentTag2, pTag)
Dim REx
Set REx = New RegExp
REx.Global = True
REx.IgnoreCase = True
REx.Pattern = "< *" & pParentTag1 & "[\r ][^>]*>[^<]*<" & pParentTag2 & "[\r ][^>]*" & pTag & " *= *""([^>=]+) *""[^>]*>[^\?]*</" & pParentTag1 & ">"
If REx.Test(pText) Then GetXMLValue2 = REx.Execute(pText)(0).SubMatches(0)
End Function
|
