Использование XML DOM в VB и MS Office/VBA
Листинг 3. Формирование объекта XMLDOC со свойствами документа
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
