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