Metin Dosyasından Mail Ayıklama YARDIM

[ozmen]

İyi Günler, Word Dosyasında Metin Biçiminde Çok Uzun Bir Mail Listem Var..
Liste Örneği;

ozden@yahoo.com<seyit_ozden@yahoo.com>;mehmetes@aidata.com.tr<mehmetes@aidata.com.tr>;ozdes@ozdestekstil.com<ozdes@ozdestekstil.com>;info@vitray.gen.tr<info@vitray.gen.tr>;sales.ozdilek@anet.net.tr<sales.ozdilek@anet.net.tr>;muhasebe@ozdoku.com.tr<muhasebe@ozdoku.com.tr>;info@ozdoku.com.tr<info@ozdoku.com.tr>;rmagden@ozege.com<rmagden@ozege.com>;info@bionikdental.com.tr<info@bionikdental.com.tr>;

oz-el@oz-el.com<oz-el@oz-el.com>;ozelmakina@hotmail.com<ozelmakina@hotmail.com>;missme.shipments@yahoo.com<missme.shipments@yahoo.com>;caner@ozelorme.com<caner@ozelorme.com>;nobeldenda2008@hotmail.com<nobeldenda2008@hotmail.com>;ozel@ozeltekstil.com<ozel@ozeltekstil.com>;ferda.imert@gmail.com<ferda.imert@gmail.com>;info@ozellermarble.com<info@ozellermarble.com>;info@ozendokum.com<info@ozendokum.com>;ibrahim-42@hotmail.com<ibrahim-42@hotmail.com>;muhasebe@ozenkutu.com.tr<muhasebe@ozenkutu.com.tr>;info@ozenmak.com.tr<info@ozenmak.com.tr>;ozenginyurt@tnn.net<ozenginyurt@tnn.net>;ozenir@ozenirmilling.com<ozenir@ozenirmilling.com>;vierigianluca@hotmail.com<vierigianluca@hotmail.com>;er-otomat@hotmail.com

Bu Listeyi Excel Yada Tekst Dosyasında Fark etmez, Mail Adresleri Ayıklayıp Alt Alta yazabilir-miyiz?

Yardımcı Olabilecek Kişiye Minnettar olacağım.

 

[Zeki Gürsoy]

Merhaba;

Listeyi bir text dosyasına yapıştırıp aşağıdaki kodu deneyin.

[SIZE=2]Sub test()
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    fd.Filters.Clear
    fd.Filters.Add "Metin dosyaları(*.txt)", "*.txt", 1
    ret = fd.Show
    If Not ret = -1 Then Exit Sub

    fn = fd.SelectedItems(1)
    
    txt = CreateObject("Scripting.FileSystemObject").OpenTextFile(fn).readall

    Set reg = CreateObject("vbscript.regexp")
    
    reg.Global = True
    reg.MultiLine = True
    reg.Pattern = "\<(.+?)\>"
    Set mcol = reg.Execute(txt)
    
    For i = 0 To mcol.Count - 1
        Cells(i + 1, "a") = mcol(i).SubMatches(0)
    Next
End Sub[/SIZE]

 

[tamer42]

Merhaba;

Listeyi bir text dosyasına yapıştırıp aşağıdaki kodu deneyin.

[SIZE=2]Sub test()
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    fd.Filters.Clear
    fd.Filters.Add "Metin dosyaları(*.txt)", "*.txt", 1
    ret = fd.Show
    If Not ret = -1 Then Exit Sub

    fn = fd.SelectedItems(1)
    
    txt = CreateObject("Scripting.FileSystemObject").OpenTextFile(fn).readall

    Set reg = CreateObject("vbscript.regexp")
    
    reg.Global = True
    reg.MultiLine = True
    reg.Pattern = "\<(.+?)\>"
    Set mcol = reg.Execute(txt)
    
    For i = 0 To mcol.Count - 1
        Cells(i + 1, "a") = mcol(i).SubMatches(0)
    Next
End Sub[/SIZE]

Sn Zeki Gürsoy Outlook "Gelen Kutusu" 'nda bulunan tüm mailler için aynı yöntemi nasıl uygulayabiliriz?

Outlook ortamında aldığımız maillerin adres bilgilerini öğrenmek istiyoruz.

Teşekkürler,

İyi Çalışmalar.

 

[Asri]

ozden@yahoo.com<seyit_ozden@yahoo.com>;mehmetes@aidata.com.tr<mehmetes@aidata.com.tr>;ozdes@ozdestekstil.com<ozdes@ozdestekstil.com>;info@vitray.gen.tr<info@vitray.gen.tr>;sales.ozdilek@anet.net.tr<sales.ozdilek@anet.net.tr>;muhasebe@ozdoku.com.tr<muhasebe@ozdoku.com.tr>;info@ozdoku.com.tr<info@ozdoku.com.tr>;rmagden@ozege.com<rmagden@ozege.com>;info@bionikdental.com.tr<info@bionikdental.com.tr>;
..[/quote]

Aşağıdaki eklentiyi yükleyip, sırası ile bu işlemleri yapın.
* metni excel e yapıştırın.
* Kolon işlemlerinden "Metni sütunlara çevir ayırıcı karakter" deki kutuya
]<>; karakterleri girip en alttan kolonu seçin ve işleme başla deyin.
* Tekrar sağ tuş özel işlemlerden kolon işlemleri, "Tüm kolonları tek kolonda topla" yı seçip tüm sayfaya uygula deyin.
* tüm mailler alt alta sıralanacaktır.

Sadece bu işlem için uzun görünebilir, ancak her an her excel dosyasında uygulayabileceğiniz 100 lerce işlem mevcut.

[URL]http://excel.web.tr/f52/excel-zel-lemler-menusu-eklentisi-sao-tu-t157219.html[/URL]

 

[Asri]

Sn Zeki Gürsoy Outlook "Gelen Kutusu" 'nda bulunan tüm mailler için aynı yöntemi nasıl uygulayabiliriz?

Outlook ortamında aldığımız maillerin adres bilgilerini öğrenmek istiyoruz.

Teşekkürler,

İyi Çalışmalar.

Excel VBA ekranında Tools\ Referans da Microsoft Outlook işaretli olmalı.

Outlook Gelen kutusundaki mail gönderenlerin mail adreslerini alır.

Sub mail_Adresi_getir()

Dim outlookApp As Outlook.Application, oOutlook As Object
Dim oInbox As Outlook.Folder, oMail As Outlook.MailItem

Set outlookApp = New Outlook.Application
Set oOutlook = outlookApp.GetNamespace("MAPI")
Set oInbox = oOutlook.GetDefaultFolder(olFolderInbox)
satir = 0
For Each oMail In oInbox.Items
    DoEvents
    satir = satir + 1
    Cells(satir, 1).Value = oMail.SenderEmailAddress
Next oMail


End Sub