Запись почтовых адресов в xml

Старая форма входа

Страница 1 из 1 1
Модератор форума: _Boroda_, китин

Мир MS Excel » Вопросы и решения » Excel и другие приложения » Outlook » Запись почтовых адресов в xml (проблемма с цифровыми адресами...)

Benos

Дата: Вторник, 05.10.2021, 21:37 | Сообщение № 1

Группа: Пользователи

Ранг: Новичок

Сообщений: 45

Репутация: 0 ±

Замечаний: 0% ±

Excel 2013 / 2016 / 365

Добрый день всем!

Пишу макрос сортировщик писем для Outlook.
Но не просто сортировщик, а файлом настроек в xml.
Все вроде работает, но столкнулся с багом (не могу понять в чем дело).
Вот кусок кода...
[vba]

Код

Set nm = oApp.GetNamespace("MAPI")

    num = nm.GetDefaultFolder(olFolderInbox).Items.Count
    For i = 1 To num
        Set oMail = nm.GetDefaultFolder(olFolderInbox).Items.item(i)
        Debug.Print oMail.SenderEmailAddress
        senderDoman = LCase(Split(oMail.SenderEmailAddress, "@")(1))

        Select Case senderDoman
            Case "mail.ru"
                Call xmlRead("email", LCase(oMail.SenderEmailAddress), oMail.SenderEmailAddress)
            Case "yandex.ru"
                Call xmlRead("email", LCase(oMail.SenderEmailAddress), oMail.SenderEmailAddress)
            Case "gmail.com"
                Call xmlRead("email", LCase(oMail.SenderEmailAddress), oMail.SenderEmailAddress)
            Case Else
                Call xmlRead("dom", LCase(senderDoman), oMail.SenderEmailAddress)
        End Select
    Next

[/vba]
Принцип прост, все письма с одного домена в одну папку, если домен "не уникальный"... привязываемся к адресу...

Вот еще один кусок кода... функция xmlRead
[vba]

Код

xmlDoc.Load ("D:\mail.xml")

    On Error Resume Next
    Set Node = xmlDoc.SelectSingleNode("//mail/" & corSender) 'corSender -адрес, в котором @ заменена на _ что бы можно было записать в xml

    If Node Is Nothing Then
        newFolder = InputBox("Введите имя папки для " & name & ".", "Новый адрес")
        If newFolder = "" Then Exit Sub
        Set rootXML = xmlDoc.SelectSingleNode("mail")
        Set newElXML = xmlDoc.createElement(corSender)
        rootXML.appendChild newElXML
        Set Node = xmlDoc.SelectSingleNode("//mail/" & corSender)
        Node.text = newFolder
        rootXML.appendChild xmlDoc.createTextNode(vbCrLf)
        xmlDoc.Save ("D:\mail.xml")
    End If

[/vba]
Тут пишем в xml данные в виде <адрес> Имя папки </адрес>
Как то так должен выглядеть фаил...
[vba]

Код

<?xml version="1.0" encoding="utf-8"?>
<mail>
   <ucoz.ru>УКОЗ<ucoz.ru>
   <xxx.ru>Для ХХХ</xxx.ru>
   <vas_mail.ru>vas@mail.ru</vas_mail.ru>
</mail>

[/vba]
Все работате, но вот почему то адреса почты... которая начинается с цифр в xml не попадает
т.е. адрес вида 333-00-22@mail.ru в фаил не запишется <333-00-22> ... </333-00-22>

На работе выдает ошибку, что то вроде "должна быть текст"...
Дома ошибок не выдает... просто пропускает и все.
Как заставить обрабатывать цифровые адреса... ума не приложу.
Буду рад если кто, что подскажет...

Заранее спасибо!

Код

[/vba]
Тут пишем в xml данные в виде <адрес> Имя папки </адрес>
Как то так должен выглядеть фаил...
[vba]

Код

<?xml version="1.0" encoding="utf-8"?>
<mail>
   <ucoz.ru>УКОЗ<ucoz.ru>
   <xxx.ru>Для ХХХ</xxx.ru>
   <vas_mail.ru>vas@mail.ru</vas_mail.ru>
</mail>

Сообщение отредактировал Benos - Вторник, 05.10.2021, 21:39

Ответить

СообщениеДобрый день всем!

Пишу макрос сортировщик писем для Outlook.
Но не просто сортировщик, а файлом настроек в xml.
Все вроде работает, но столкнулся с багом (не могу понять в чем дело).
Вот кусок кода...
[vba]

Код

[/vba]
Тут пишем в xml данные в виде <адрес> Имя папки </адрес>
Как то так должен выглядеть фаил...
[vba]

Код

<?xml version="1.0" encoding="utf-8"?>
<mail>
   <ucoz.ru>УКОЗ<ucoz.ru>
   <xxx.ru>Для ХХХ</xxx.ru>
   <vas_mail.ru>vas@mail.ru</vas_mail.ru>
</mail>

Автор - Benos
Дата добавления - 05.10.2021 в 21:37

Апострофф

Дата: Среда, 06.10.2021, 01:56 | Сообщение № 2

Группа: Проверенные

Ранг: Обитатель

Сообщений: 445

Репутация: 123 ±

Замечаний: 0% ±

Excel 1997

[vba]

Код

Case "mail.ru"
Call xmlRead("email", LCase(oMail.SenderEmailAddress), oMail.SenderEmailAddress)
Case "yandex.ru"
Call xmlRead("email", LCase(oMail.SenderEmailAddress), oMail.SenderEmailAddress)
Case "gmail.com"
Call xmlRead("email", LCase(oMail.SenderEmailAddress), oMail.SenderEmailAddress)

[/vba]
можно свернуть в одну строку.
А про цыфры, ? Мне надо попасть на ваш рабочий стол, чтобы понять проблему.

Сообщение отредактировал Апострофф - Среда, 06.10.2021, 01:57

Ответить

Benos

Дата: Среда, 06.10.2021, 11:03 | Сообщение № 3

Группа: Пользователи

Ранг: Новичок

Сообщений: 45

Репутация: 0 ±

Замечаний: 0% ±

Excel 2013 / 2016 / 365

Чуть чуть погорячился... вот пример...
[vba]

Код

Sub Test()
    Call xmlRead("TEST1", "TEXT1")
    Call xmlRead("TEST2", "22-22-33")
    Call xmlRead("TEST3", "12345")
    Call xmlRead("11212", "TEXT") 'не пишет в Фаил
    Call xmlRead("11-22", "1212") 'не пишет в фаил
End Sub
Sub xmlRead(name, txt)
    Dim Node As MSXML2.IXMLDOMNode
    Dim rootXML As MSXML2.IXMLDOMNode
    Dim newElXML As MSXML2.IXMLDOMElement
    Dim xmlDoc As MSXML2.DOMDocument60
    Set xmlDoc = New MSXML2.DOMDocument60

    xmlDoc.Load ("D:\mail.xml")

    On Error Resume Next
    Set Node = xmlDoc.SelectSingleNode("//mail/" & name)

    If Node Is Nothing Then
        newFolder = LCase(newFolder)
        Set rootXML = xmlDoc.SelectSingleNode("mail")
        Set newElXML = xmlDoc.createElement(name)
        rootXML.appendChild newElXML
        Set Node = xmlDoc.SelectSingleNode("//mail/" & name)
        Node.text = txt
        rootXML.appendChild xmlDoc.createTextNode(vbCrLf)
        xmlDoc.Save ("D:\mail.xml")
    End If
End Sub

[/vba]
Результат работы
[vba]

Код

<?xml version="1.0" encoding="utf-8"?>
<mail>
    <TEST1>TEXT1</TEST1>
    <TEST2>22-22-33</TEST2>
    <TEST3>12345</TEST3>
</mail>

[/vba]
Как записать узел с именем в виде цифр?

Пока вижу только вариант первым символом добавлять букву... это скажем так "заплатка".

Ответить

Страница 1 из 1
1