Листинг 3. Формирование объекта XMLDOC со свойствами документа

Приложение к статье "Использование XML DOM в VB и MS Office/VBA"

Public Function DocPropertiesToXML(ThisDoc As Object) As DOMDocument
    ' Формирование XMLDOC-объекта со свойствами документа
    Dim xmlDoc As DOMDocument
    Dim propertiesNode As IXMLDOMElement
    Dim propertyNode As IXMLDOMElement
    Dim Index%, propertyvalue$
    
    ' создание объекта
    Set xmlDoc = CreateObject("Microsoft.XMLDOM")
    xmlDoc.loadXML "<DocProperties/>"
    
    Set propertiesNode = xmlDoc.documentElement
    ' имя файла
    Set propertyNode = propertiesNode.appendChild( _
       xmlDoc.createElement("FileName"))
    propertyNode.Text = ThisDoc.FullName
    'MsgBox ThisDoc.FullName
    ' запись содержимого встроенных свойств документа
    For Index = 1 To ThisDoc.BuiltInDocumentProperties.Count
      ' создание узла со свойствами
      Set propertyNode = propertiesNode.appendChild( _
       xmlDoc.createElement(Replace( _
       ThisDoc.BuiltInDocumentProperties(Index).Name, " ", "_")))
      ' запись содержимого
      On Error Resume Next
      propertyvalue = ThisDoc.BuiltInDocumentProperties(Index)
      If Err.Number <> 0 Then propertyvalue = "XXXX" 'неопределено
      propertyNode.Text = propertyvalue
    Next
    Set DocPropertiesToXML = xmlDoc
End Function

Public Sub DocPropertyToLogXML(ThisDoc As Object)
   ' Запись информации о закрываемом файле в Log-файл
   Dim xmlDoc As DOMDocument
   Dim xmlLog As DOMDocument
   Dim DocItem As IXMLDOMElement
   Dim logFile$
   logFile = "d:\logfile.xml"   ' имя Log-файла
   '
   ' создаем XMLDOC-объект для текщего документа
   Set xmlDoc = DocPropertiesToXML(ThisDoc)
   
   ' подключаем его к Log-файлу
   ' открываем Log-файл
   Set xmlLog = New DOMDocument
   xmlLog.Load logFile$
   If xmlLog.parseError.errorCode <> 0 Then
    ' файл не был создан, формируем новый
    xmlLog.loadXML "<DocLog/>"
   End If
   Set DocItem = xmlLog.selectSingleNode("//DocLog")
   If xmlLog.selectNodes("//DocProperties").Length > 0 Then
    ' уже есть описания свойств,
    ' вставляем новое описание сверху
    DocItem.InsertBefore _
       xmlDoc.documentElement.cloneNode(True), _
       DocItem.childNodes(0)
   Else ' вставляем первый элемент
    DocItem.appendChild xmlDoc.documentElement.cloneNode(True)
   End If
   xmlLog.Save logFile ' сохраняем
End Sub

В начало статьи