Использование XML DOM в VB и MS Office/VBA

Источник: http://www.microsoft.ru/offext/developers/materials/material.aspx?id=49

Одна из "горячих" ИТ-тем нынешнего года - проблема интеграции разнородных информационных ресурсов, решение которой требует создания простого и надежного механизма обмена данными между различными приложениями. И сегодня, кажется, уже все знают: XML -- вот золотой ключик, который должен навести порядок в информационном хаосе великого множества форматов данных.

Напомним, что XML и HTML базируется на одинаковых синтаксических принципах - информация записывается виде простого текста, в котором имеются управляющие команды (тэги) и собственно данные. XML отличается от HTML тем, что позволяет передавать не только данные, но также и информацию об их структуре. То есть HTML ориентирован на описание неструктурированных данных, а XML - структурированных. С точки зрения использования информации неструктурированные данные предназначены в первую очередь для визуального восприятия человеком, струкутрированные - для автоматической обработки (в том числе вычислений). Отметим, что оба этих языка представляют собой упрощенный вариант давно известного среди компьютерных лингвистов языка SGML (Standard Generation Markup Language).

Подчеркнем, что сама по себе идея языка XML - текстового описания структуры и содержания некоторых данных - совсем не нова. Главным моментом здесь является то, что лидеры компьютерной индустрии вроде бы осознали необходимость перехода от внутренних, закрытых форматов к общим, открытым. (Но, честно говоря, вопрос о том, насколько это серьезное намерение (а не маркетинговые акции, чтобы показать свою готовность к открытости) можно будет судить лишь спустя некоторое время.) XML -- это мировой отраслевой стандарт, создание и развитие которого ведется под эгидой WWW Consortioum -- общественной организацией, представляющей интересы входящих в нее участников рынка).

Если же говорить о прикладных программистов, то они уже очень давно оценили преимущества простых текстовых форматов данных по сравнению с двоичными при информационном взаимодействии компонентов вычислительных систем. Могу сослаться на пример из собственной программисткой практики десятилетней давности. При разработке информационно-аналитических систем для обработки геологических данных мы полностью перешли на текстовые форматы данных и описаний их структуры, резко сократив время на отладку программного комплекса и его конфигурирование под задачи пользователей. Сначала мы рассматривали такое решение как временное и хотели для повышения производительности перейти на двоичные форматы. Но жизнь сама показала, что это - пустая трата времени, так как производительность компьютеров росла быстрее, чем объем базы данных.

Важное замечание. Текстовое представление данных имеет свои недостатки. Одно из них - проблемы с использованием символов, задействованных в качестве специальных (например, "<" и ">"). Вторая проблема - неоднозначность преобразования данных из внутреннего двоичного формата в текст и наоборот. В последнем случае особенное внимание нужно уделять национальной специфике форматов, особенно при работе с разными региональными установками и кодовыми таблицами.

В этой связи нужно определенно сказать, что появление общего стандарта описания данных избавляет разработчиков придумывать собственные форматы. Разумеется, за любую универсальность приходится расплачиваться определенной избыточностью, но в данном случае она будет не столь велика и не будет сколь-нибудь заметна на современных компьютерах. Например, мне бы пришлось заменить свои старые описания параметров

LastName = Колесов 

на

Колесов 

Прежде чем перейти к конкретным техническим вопросам стоит также сделать еще одно важное замечание. Сам по себе XML не решает проблемы преобразования XML-документов, что необходимо для передачи данных между приложениями. Упрощенно говоря, XML лишь связывает, например, некоторый набор чисел с понятием (тегом) "цена", но, что означает данный термин, язык уже не может расшифровать. Таким образом, для правильной интерпретации содержимого XML-документов необходимо знать так называемую XML-схему, которая бы описывала бы смысл полей данных.

 

Введение в XML DOM

Visual Basic 6.0 и приложения MS Office 2000 не включают поддержку XML на уровне пользователя и разработчика, хотя этом многие приложение Office используют передачу данных с помощью XML для выполнения внутренних операций. Вместе с тем, уже сегодня, не дожидаясь будущих версий этих систем (там что-то, связанное с XML, должно появиться), программисты могут применять XML-формат для обмена информацией с помощью написания собственных достаточно простых программных конструкций. Видятся два пути реализации этой задачи:

1. Использование специального объекта XML, называемого XMLDOM или DOMDocument (DOM - Document Object Model). Работа с этим объектом выполняется с помощью библиотеки Microsoft XML 2.0 (MSXML.DLL), на которую нужно сделать ссылку в окне Reference. (Обратите внимание: на моем компьютере в списке ссылок эта библиотека в начальный момент имеет индекс 1.0, а уже после ее подключения меняет его на 2.0.)

С точки зрения программиста в применении DOMDocument можно выделить три момента:

 

• формирование его структуры и содержания, а также выборка из него необходимой информации;
• преобразование объекта из внутреннего формата во внешний текстовый XML-файл (в том числе вставка объекта в уже существующий файл) и наоборот;
• возможность передачи объекта внутри приложения, а также обеспечение доступа к нему из других приложений с помощью ActiveX.

2. На практике наиболее частой задачей является экспорт-импорт с помощью XML-файла, что можно делать с помощью обычных средств VB/VBA. Вывод данных в формате XML является вообще достаточно тривиальной задаче. С вводом дело обстоит посложнее, так как в этом случае нужно "руками" писать код для анализа синтаксиса и для разборки элементов документа. Как бы то ни было, в любом случае программист должен иметь в виду "ручной" метод экспорта-импорта, который иногда может быть очень полезен.

 

Передача набора записей из VB-приложения в Excel

В наших "Советах для тех, кто программирует на VB" мы приводили два примера импорта данных из таблицы (набора записей, Recordset) в виде просто текстового файла (Совет 297) и HTM-файла (Совет 329). Попробуем выполнить аналогичную задачу с помощью XML-файла, который потом прочитаем в Excel.

Импорт данных

Для тестирования мы сделаем базу данных с таблицей такого содержания

FirstName LastName BirthDate Height Sergey Sokolov 03.11.52 1,82 Андрей Petrov 17.08.58 1,77 Света Суслова 23.09.67 1,65

Далее напишем код, который обращается для импорта данных к процедуре ExportXML (листинг 1):

Dim strConnectString$, strSQL$, strHeading$
  Dim cnn As ADODB.Connection
  Dim rs As Recordset 

strConnectString = "Provider=Microsoft.Jet.OLEDB.3.51;" & _
    "Persist Security Info=False;" & _
    "Data Source=C:\vb-db\xmltest.mdb"
strSQL = "Select FirstName +' ' + LastName as Name, " & _
    "BirthDate, Height as Рост" & _
    " from Employees Order by LastName, FirstName"
strHeading = "Список сотрудников"

Set cnn = New ADODB.Connection
  Set rs = New ADODB.Recordset 
  cnn.Open strConnectString$ ' устанавливаем связь
  Set rs = cnn.Execute(strSQL) ' создаем Recordset

  Call ExportXML(rs, strHeading$, "d:\file1.xml") 

В результате его выполнения получим XML-файла, содержимое которого лучше всего посмотреть в Internet Explorer (рис.1). В плане понимания выполненных нами действий нужно отметить следующие моменты:

 

1. В IE 5.0 мы видим почти точное содержимое XML-файла (в отличие от HML, когда браузер выдает отформатированный вид документа) - в содержительном плане мы увидели бы то же самое с помощью Notepad. Но с некоторыми отличиями по форме. В частности, Физически файл, сформированный при сохранении DOMDocument, представляет ОДНУ тестовую строку с переводом строки (vbCrLf) в конце. IE представил ее в виде структурированного иерархического дерева, которое можно просматривать, открывая и закрывая его узлы.
2. Мы специально использовали в исходных данных русские тексты, чтобы показать, что их можно использовать для передачи, как названий полей (тегов), так и их содержимого. По умолчанию в XML-файл русский текст записывается в двухбайтовой кодировке UTF-8 (это можно увидеть в редакторе Notepad), но при использовании параметра "encoding" можно применять и другие кодировки.
3. Имена элементов (тегов) не могут включать пробелы. Поэтому мы с помощью оператора Replace автоматически меняем возможные пробелы на символ подчеркивания.

рис. 1

Создание нового DOMDocument объекта начинается со строки кода:

Dim xmlDoc As DOMDocument
Set xmlDoc = New DOMDocument
StartString$ = "" ' начальная строка 
                                         ' (может отсутствовать)
MainNode$ = "<Главный_узел_объекта/>"  главный узел объекта
xmlDoc.loadXML StartString$ + MainNode$ 

Для выбора кодировки передаваемых данных нужно сформировать начальную строку следующего вида:

StartString$ = "" 

но мне этого не удалось сделать - выдавалась сообщение о невозможности создания объекта.

Ввод данных

Для ввода сформированного XML-файла в Excel используем функцию ImportXML, которая создает объект DOMDocument, который можно затем дополнительно обрабатывать, и записывает введенные значения в рабочую таблицу. Ввод данных можно сделать с помощью такой макрокоманды:

Sub MyMacro()
   Set mXML = ImportXML("D:\file1.xml")
End Sub 

В результате ее выполнения мы получим заполненную таблицу рабочей книги (рис. 2).

рис. 2

Теперь внимательней посмотрим, как производится ввод данных из созданного нами XML-файла. Обращение к функции ImportXML (Excel) в общем случае выглядит следующим образом:

   Set mXML = ImportXML(xmlFile$, ObjectPath$, PropertyPath$) 

Если мы используем установку ObjectPath = "*" (по умолчанию), то работа ведется во всеми объектами документа. В нашем случае это будут узлы с тегами (они могут иметь произвольные имена, в том числе одинаковые, например ), а включенные в них теги - свойствами. При формировании таблицы в Excel для определения имен колонок мы анализировали содержимое только первого узла, считая все узлы однородными.

Однако если мы укажем ObjectPath = "", то выборка будет сделана только для данного узла. То же также можно управлять выборкой отдельных полей, например указав PropertyPath = "BirthDate".

Вопросы перекодировок данных

Анализируя выполненные нами операции по передачи данных, в первую очередь обратим внимание на то, что все данные (содержимое полей набора записей) передаются в виде текста. Преобразование информации в нашем случае выполнялось средствами VB, и поэтому был автоматически выбран формат в соответствии с текущими региональными установками. Принимающее приложение (Excel) также получило обычные текстовые данные, которые могут быть интерпретированы в принципе самым произвольным образом. Обратите внимание, что ячейки таблицы (рис.2) заполнены обычным текстом, в неопределенном формате (внешний признак этого - выравнивание по левому краю).

Такая ситуация чревата ошибками при передаче XML-данных между компьютерами, имеющими разные региональные установки (для Америки значение "23.09.53" является недопустимой датой, а "1,23" - недопустимым числом). Для решения эта проблемы есть несколько путей. Например, можно применять пользовательские атрибуты, которые будет понимать и передатчик и приемник информации. Второй вариант -- присвоить каждому свойству узла "жесткий" тип данных и тогда будет использоваться соответствующий фиксированный формат

Для реализации первого способа немного модифицируем код функции RecordsetToXMLDOM:

For Each fldField In rs.Fields  ' запись полей записи
  ' создание нового элемента
  Set xmlField = xmlFields.appendChild( _
    xmlDoc.createElement(Replace(fldField.Name, " ", "_")))
  ' установка аттрибута "MyType"
  Set attr = xmlDoc.createAttribute("MyType")
  attr.Value = fldField.Type
  xmlField.Attributes.setNamedItem attr
  
  xmlField.Text = fldField.Value  ' запись содержимого
Next 

В результате этого в сформированном коде в теги с наименованием полей добавятся атрибуты с кодами типов данных (рис. 3). Соответственно при вводе данных их значения можно прочитать и сделать соответствующую установку форматов ячеек:

рис. 3

DateType = propertyNode.Attributes(0).nodeValue 

Для второго варианта нужно использоваться фиксированный, закрепленный за типом данных формат. Например, для переменных типа дата установку такого атрибута можно выполнить

Set attr = xmlDoc.createAttribute("dt:dt")
attr.Value = "date"
xmlField.Attributes.setNamedItem attr 

или воспользоваться свойством dataType:

xmlField.dataType = "date" 

В это случае записываемые данных должны иметь обязательный формат даты "ГГГГ-ММ-ДД":

xmlField.Text = "2000-12-02" 

Нужно также отметить, что тип поля необязательно задавать в каждом теге. Можно, например, сделать один раз такое описание всех полей при формировании узла или всего документа (в том числе со ссылкой на XML-схему).

 

Вывод данных о свойствах Word-документа

Теперь попробуем решить такую задачу: будем формировать протокол работы с документами Word 2000, записывая информацию о встроенных свойствах при завершении работы с документом. Для начала напишем функцию DocPropertiesToXML, формирующую DOMDocument-объект для одного документа (листинг 3). Поместим эту функцию в модуль в составе глобального шаблона Normal.dot (нужно также для шаблона указать ссылку на MSXML.DLL). Далее создадим макрокоманду, которая будет формировать XML-файл для одного документа:

Public Sub OneDocPropertyToXML()

  Dim xmlDoc As DOMDocument
  Set xmlDoc = DocPropertiesToXML(ThisDocument)
   'можно создавать файл с оригинальным именем
  xmlDoc.Save "d:\Myfile.xml"
End Sub 

В результате вы получите файл со свойствами одного документа (фрагмент файла изображен на рис. 4). Его содержимое можно прочитать созданной ранее процедурой ImportXML в Excel, но для этого обращение к ней должно выглядеть следующим образом (главный узел должен быть указан в качестве объекта):

рис. 4

Set mXML = ImportXML("D:\myfile.xml", "//DocProperties") 

Напишем процедуру DocPropertyToLogXML, которая будет создавать файл протокола. Обратите внимание на операции включения созданного для конкретного документа XML-объекта в объекта Log-файла. Теперь создайте макрокоманду, которая будет добавлять информацию об активном документе в протокол:

Call DocPropertyToLogXML(ThisDocument) 

В результате вы будет автоматически формировать XML-файл, структура которого приведена на рис. 5). Его также можно прочитать в Excel:

Set mXML = ImportXML("D:\logfile.xml") 

рис. 5

Примечание. Обращение на запись информации в Log-файл можно поместить в процедуру ThisDocument_Close каждого документа. Механизм программного формирования такого кода в каждом открываемом файле описан в статье Владимира Биллига "Документы Office 2000 и их проекты".

 

Создание архива входящей почты

Приведем еще один пример использования XML-файла, на этот раз для хранения архива поступающей электронной почты. Для этого нужно сначала сформировать две событийные процедуры:

Dim mailBagFileName As String
Dim AttachmentsDirectory As String

Private Sub Application_Startup()
   ' Инициализация при запуске прилежения
    ' файл с архивом входящей почты
    mailBagFileName = "d:/xmlPro/mailBag.xml"
    ' каталог для хранения присоединенных файлов
    AttachmentsDirectory = "d:/xmlPro/"
End Sub

Private Sub Application_NewMail()
   ' При поступлении нового письма производится запись его в архив
    Dim mailItems As Items
    Dim mailmsg As MailItem
     
    ' Папка с входящими письмами
    Set mailItems = Application.Session.GetDefaultFolder( _
      olFolderInbox).Items
    Set mailmsg = mailItems.GetLast ' выбираем последнее
    ' Запись поступившего письма в XML-объект
    Set xmlMail = MessageToXML(mailmsg, AttachmentsDirectory)
   ' запись в архив
    Call AddMessageToArchive(xmlMail, mailBagFileName)
End Sub 

Ключевым процедурами в этой задаче являются процедуры MessageToXML и AddMessageToArchive (листинг 5). Общая логика формирования архива очень похожа на то, что мы делали, создавая протокол работы с Word-файлами: сначала преобразуем содержимое письма в DOMDocunemt, а потом подключаем его к единому файлу. Новшеством здесь является то, что документ письма имеет более сложную структуру (появились вложенные узлы для описания подключенных файлов) и для хранения тела письма используем секцию CDATA (содержимое письма может иметь символы, нарушающие синтаксис XML). Результат преобразования в XML показан на рис. 6.

рис. 6

Чтобы закончить с этой задачей, остается только написать ASP-cтраницу (листинг 6), который преобразует содержимое XML-архива писем в HTML-формат (рис. 7).

рис. 7

 

 

Листинг 1.

Преобразование Recordset в DOMDocument-объект, а затем сохранение его в виде XML-файла.

Public Sub ExportXML(rs As Recordset, strHeading$, FileName$)
  
  ' Экспорт таблицы RecordSet в XML файл
  Dim xmlDoc As DOMDocument
  
  ' Cоздаем XMLDOM-объект
  Set xmlDoc = RecordsetToXMLDOM(rs, strHeading$)
  ' выводим его в виде отдельного файла
  xmlDoc.Save FileName$
End Sub

Public Function RecordsetToXMLDOM(rs As Recordset, strHeading$) As DOMDocument
  '
  ' Преобразование Recordset в DOMDocument
  '
  Dim fldField As Field
  Dim xmlDoc As DOMDocument
  Dim xmlFields As IXMLDOMElement
  Dim xmlField As IXMLDOMElement
  Dim i&

  ' создание экземпляра объекта
  Set xmlDoc = CreateObject("Microsoft.XMLDOM")   ' New DOMDocument
  ' записываем XML-константу объекта
  xmlDoc.loadXML "" + _
    Replace("<" + strHeading + "/>", " ", "_")
  
  With rs
    ' Вывод содержимого полей таблицы
    .MoveFirst: i=1
     Do Until .EOF
       ' создание нового узла
       Set xmlFields = xmlDoc.documentElement.appendChild _
        (xmlDoc.createElement("OneRow" +LtRim(Str(i))))
      
       For Each fldField In rs.Fields  ' запись полей записи
          Set xmlField = xmlFields.appendChild( _
           xmlDoc.createElement(Replace(fldField.Name, " ", "_")))
           xmlField.Text = fldField.Value
       Next
      .MoveNext  ' к следующей записи набора
       i = i + 1
    Loop
  End With
  Set RecordsetToXMLDOM = xmlDoc  ' возвращаем созданный объект
End Function 

 

Листинг 2.

Импорт XML-файла и преобразование его в таблицы Excel

Public Function ImportXML(xmlFileName As String, _
    Optional objectPath As String = "*", _
    Optional propertyPath As String = "*", _
    Optional baseCell As Range = Nothing) As DOMDocument
    ' Экспорт данных из XML-файла
    ' 1. формируется DOMDocument объект (ImportXML)
    ' 2. По заданным параметрам данные из объекта
    '    переписываются в рабочую книгу
    ' ПАРАМЕТРЫ:
    ' xmlFileName - исходный XML-файла
    ' baseCell - исходный диапазон ячеек
    ' objectPath - строка запроса (queryString) на выборку узлов
    ' propertyPath - строка запроса (queryString) на выборку свойств
    '
    Dim xmlDoc As DOMDocument
    Dim objectNodeList As IXMLDOMNodeList
    Dim objectNode As IXMLDOMElement
    Dim propertyNode As IXMLDOMElement
    Dim baseRow&, baseCol&, rowIndex&, colIndex&

    ' координаты ячеек, куда будем записывать
    If baseCell Is Nothing Then  'установка по умолчанию
      Set baseCell = ActiveCell
    End If
    baseRow = baseCell.Row
    baseCol = baseCell.Column
    
    ' создание DOMDocument объекта
    Set xmlDoc = New DOMDocument
    xmlDoc.Load xmlFileName ' загрузка XML-файла
    ' Перезапись данный в таблицу рабочей книги
    ' выбор узла
    Set objectNodeList = xmlDoc.documentElement.selectNodes(objectPath)
    If objectNodeList.Length > 0 Then
        colIndex = 0
        ' формирование заголовка таблицы
        Set objectNode = objectNodeList(0)
        For Each propertyNode In _
            objectNode.selectNodes(propertyPath)
            ActiveSheet.Cells(baseRow, baseCol + colIndex).Value = _
                propertyNode.nodeName
            colIndex = colIndex + 1
        Next
        ' выделение заголовка таблицы (первой строки) жирным шрифтом
        ActiveSheet.Range(Cells(baseRow, _
            baseCol), Cells(baseRow, baseCol + _
            colIndex)).Font.Bold = True
        ' выборка всех остальных строк таблицы
        rowIndex = 1
        For Each objectNode In objectNodeList  ' все узлы
            colIndex = 0
            For Each propertyNode In _
                objectNode.selectNodes(propertyPath)
                ActiveSheet.Cells(baseRow + rowIndex, _
                    baseCol + colIndex).Value = _
                    propertyNode.Text
            colIndex = colIndex + 1
            Next
            rowIndex = rowIndex + 1
        Next
    End If
    Set ImportXML = xmlDoc  ' созданный DOMDocument
End Function 

 

Листинг 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 ""
    
    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 ""
   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 

 

Листинг 4.

Формирование Log-файла со свойствами документов

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 ""
   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 

 

Листинг 5.

Процедуры преобразования входящих писем в XML-архив

Public Function MessageToXML(itm As MailItem, attachmentPath As String)
    ' Запись поступившего письма в XML-объект
    
    Dim xmldoc As DOMDocument
    Dim mailNode As IXMLDOMElement
    Dim attachmentsNode As IXMLDOMElement
    Dim attachmentNode As IXMLDOMElement
    Dim attachObj As Attachment
    Dim recpt As Recipient

    Set xmldoc = New DOMDocument
    xmldoc.loadXML ""
    Set mailNode = xmldoc.documentElement
    ' информация об отправителе
    addElement "sender", mailNode, itm.SenderName
    Set recpt = itm.Recipients.Add(itm.SenderName)
    recpt.Resolve
    If recpt.Resolved Then
        addElement "senderEmail", mailNode, _
          recpt.AddressEntry.address
    End If
    ' время получения
    addElement "receivedTime", mailNode, itm.ReceivedTime
    
    ' обработка информации о присоединенных файлах
    If itm.Attachments.Count > 0 Then
      Set attachmentsNode = addElement("attachments", mailNode)
      On Error Resume Next
      For Each attachObj In itm.Attachments
        Set attachmentNode = addElement( _
           "attachment", attachmentsNode)
        addElement "fileName", attachmentNode, _
                               attachObj.filename
        addElement "pathName", attachmentNode, _
                               attachmentPath
        addElement "displayName", attachmentNode, _
                               attachObj.DisplayName
          ' запомнить присоединенные файлы
          attachObj.SaveAsFile _
            attachmentPath + attachObj.filename
      Next
      On Error GoTo 0
    End If
    ' тема и тело письма
    addElement "subject", mailNode, itm.Subject
    addElement "body", mailNode, itm.body, True
    
    Set MessageToXML = xmldoc
End Function

Public Sub AddMessageToArchive(xmldoc As DOMDocument, filename$)

    ' Запись поступившего письма в XML-архив
    Dim externalDoc As DOMDocument
    Dim mailItemsNode As IXMLDOMElement

    ' подключение объекта одного письма к архиву
    Set externalDoc = New DOMDocument
    externalDoc.Load filename
    If externalDoc.parseError.errorCode <> 0 Then
        externalDoc.loadXML ""
    End If
    Set mailItemsNode = externalDoc.selectSingleNode( _
                        "//mailItems")
    If externalDoc.selectNodes("//mailItem").Length > 0 Then  'существует
        mailItemsNode.insertBefore _
            xmldoc.documentElement.cloneNode( _
            True), mailItemsNode.childNodes(0)
    Else
        mailItemsNode.appendChild _
            xmldoc.documentElement.cloneNode(True)
    End If
    externalDoc.Save filename
End Sub

Public Function addElement(ElementName As _
    String, ParentNode As IXMLDOMElement, _
    Optional ElementValue As Variant = Null, _
    Optional asCData As _
    Boolean = False) As IXMLDOMElement
    ' добавление описания параметра к объекту
    
    Dim node As IXMLDOMElement
    Dim cdataTextNode As IXMLDOMCDATASection
    Set node = ParentNode.appendChild( _
      ParentNode.ownerDocument.createElement( _
      ElementName))
    If Not IsNull(ElementValue) Then
      If asCData Then ' элемент типа CDATA
        Set cdataTextNode = node.appendChild( _
          ParentNode.ownerDocument. _
          createCDATASection(ElementValue))
      Else  ' обычный элемент
        node.Text = CStr(ElementValue)
      End If
    End If
    Set addElement = node
End Function 

 

Листинг 6.

Код ASP-страницы для вывода информации о содержимом архива почты

<%@LANGUAGE="VBSCRIPT"%>
<HTML>
<HEAD>
<TITLE>Архив поступающей почты</TITLE>
</HEAD>
<BODY>
<H2>Архив поступающей почты</H2>
<HR>
<%
dim xmlDoc
dim msgNode
dim attachNode
dim returnAddress

set xmlDoc=createObject("Microsoft.XMLDOM")
xmlDoc.load  "d:/xmlpro/mailbag.xml"  'server.mapPath("d:/xmlpro/mailbag.xml")
for each msgNode in xmlDoc.selectNodes("//mailItem")
response.write "<H4>"+msgNode.selectSingleNode( _
        "subject").text+"</H4>"

for each attachNode in msgNode.selectNodes( _
		"attachments/attachment")
  response.write "<IMG src='" _
    + attachNode.selectSingleNode("pathName").text _
    + attachNode.selectSingleNode("fileName").text _
    + "'><br>"
next
response.write "<p>Адрес отправитель: "
set returnAddress = msgNode.selectSingleNode("senderEmail")
if not (returnAddress is nothing) then
	response.write "<A href='mailto:"+returnAddress.text+"'>"
end if
response.write msgNode.selectSingleNode("sender").text
if not (returnAddress is nothing) then
	response.write "</A>"
end if
response.write " / время получения "
response.write msgNode.selectSingleNode( _
	"receivedTime").text
response.write "<pre>"+msgNode.selectSingleNode( _
	"body").text+"</pre>"
response.write "<HR>"
next
%>
</BODY></HTML>

 

© Андрей Колесов
© Оформление и подготовка к публикации Корпорация Microsoft

В соответствии с соглашением между Microsoft и авторами публикуемых на Web-сервере материалов, представленные здесь материалы или их фрагменты могут воспроизводиться в обычных и электронных изданиях без специального согласования с авторами, но с обязательной ссылкой на авторов и данный Web-узел (с указанием URL конкретной страницы).