Пишу макрос сортировщик писем для 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]
[/vba] Все работате, но вот почему то адреса почты... которая начинается с цифр в xml не попадает т.е. адрес вида 333-00-22@mail.ru в фаил не запишется <333-00-22> ... </333-00-22>
На работе выдает ошибку, что то вроде "должна быть текст"... Дома ошибок не выдает... просто пропускает и все. Как заставить обрабатывать цифровые адреса... ума не приложу. Буду рад если кто, что подскажет...
Заранее спасибо!
Добрый день всем!
Пишу макрос сортировщик писем для 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]
[/vba] Все работате, но вот почему то адреса почты... которая начинается с цифр в xml не попадает т.е. адрес вида 333-00-22@mail.ru в фаил не запишется <333-00-22> ... </333-00-22>
На работе выдает ошибку, что то вроде "должна быть текст"... Дома ошибок не выдает... просто пропускает и все. Как заставить обрабатывать цифровые адреса... ума не приложу. Буду рад если кто, что подскажет...
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]
Код
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