Домашняя страница Undo Do Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Запись почтовых адресов в xml - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: _Boroda_, Manyasha, SLAVICK, китин  
Мир MS Excel » Вопросы и решения » Excel и другие приложения » Outlook » Запись почтовых адресов в xml (проблемма с цифровыми адресами...)
Запись почтовых адресов в xml
Benos Дата: Вторник, 05.10.2021, 21:37 | Сообщение № 1
Группа: Пользователи
Ранг: Новичок
Сообщений: 37
Репутация: 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>

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

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


Сообщение отредактировал Benos - Вторник, 05.10.2021, 21:39
 
Ответить
СообщениеДобрый день всем!

Пишу макрос сортировщик писем для 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>

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

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

Автор - Benos
Дата добавления - 05.10.2021 в 21:37
Апострофф Дата: Среда, 06.10.2021, 01:56 | Сообщение № 2
Группа: Проверенные
Ранг: Обитатель
Сообщений: 380
Репутация: 109 ±
Замечаний: 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
 
Ответить
Сообщение[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:56
Benos Дата: Среда, 06.10.2021, 11:03 | Сообщение № 3
Группа: Пользователи
Ранг: Новичок
Сообщений: 37
Репутация: 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]
Как записать узел с именем в виде цифр?

Пока вижу только вариант первым символом добавлять букву... это скажем так "заплатка".
 
Ответить
СообщениеЧуть чуть погорячился... вот пример...
[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]
Как записать узел с именем в виде цифр?

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

Автор - Benos
Дата добавления - 06.10.2021 в 11:03
Мир MS Excel » Вопросы и решения » Excel и другие приложения » Outlook » Запись почтовых адресов в xml (проблемма с цифровыми адресами...)
  • Страница 1 из 1
  • 1
Поиск:

Яндекс.Метрика Яндекс цитирования Jobsora jooble
© 2010-2021 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!