jak wyciągnąć adresy z oryginalej wiadomości ?

Pytania, problemy, uwagi związane ze starszymi wersjami Microsoft Outlook 2003, 2002 (XP), 2000, 98

Moderator: Moderatorzy

jak wyciągnąć adresy z oryginalej wiadomości ?

Postprzez los_kowalos » Pt 26.10.2007 11:14

Witam
Dostałem meila od osoby, która adresowała go wielu innych osób i pytanie brzmi jak można wyciągnąć nazwy osób i adresy z oryginalnej wiadomości z pola "To:" bez męczenia się metodą Ctrl C, Ctrl V ? :?

Jest jakaś metoda? Pomóżcie!!! :!:
los_kowalos
 
Posty: 25
Dołączył(a): Pt 26.10.2007 11:04

Postprzez Łukasz M. » Pt 26.10.2007 14:09

Należy stworzyć makro w Visual Basic Editor (ALT+F11) i w ThisOutlookSession wkleić poniższy kod:

Kod: Zaznacz cały
Public Sub ZapiszNadawcow()
   
    Open "C:/recipients.txt" For Output As #1
   
    For Each mail In Application.ActiveExplorer.Selection
        For Each recip In mail.Recipients
            Print #1, recip
        Next
    Next
   
    Close #1

End Sub


Po zapisaniu należy zamknąć edytor. Teraz zaznaczyć określone e-maile i uruchomić makro (ALT+F8). W nowo otwartym oknie wybrać nasze makro i kliknąć przycisk Uruchom. Powyższe makro będzie zapisywało wszystkich nadawców e-maila w pliku C:/recipients.txt.


W razie niejasności z uruchomieniem makra odsyłam do artykułu [1], w którym wyjaśnione jest wszystko krok po kroku.

[1] http://www.codetwo.pl/articles/macros/i ... _makro.php
Łukasz M.
 
Posty: 95
Dołączył(a): Pt 03.08.2007 10:53
Lokalizacja: Jelenia Góra

Postprzez los_kowalos » Pt 26.10.2007 14:20

zrobiłem wszystko tak jak pisałeś a po uruchomieniu makra takie cos mi wywaliło:

"The macros in this project are disabled. please refer to the online help or documentation of the host application to determine how to enable macros"

Co jest nie tak?

PS. mam outlook 2003
los_kowalos
 
Posty: 25
Dołączył(a): Pt 26.10.2007 11:04

Postprzez Łukasz M. » Pt 26.10.2007 14:58

Należy zmniejszyć poziom zabezpieczeń Outlooka, w tym celu w menu Narzędzia | Makro wybrać Zabezpieczenia i w nowo otwartym oknie zaznaczyć Niski poziom zabezpieczeń.
Łukasz M.
 
Posty: 95
Dołączył(a): Pt 03.08.2007 10:53
Lokalizacja: Jelenia Góra

Postprzez los_kowalos » N 28.10.2007 18:00

Łukasz M. napisał(a):
Po zapisaniu należy zamknąć edytor. Teraz zaznaczyć określone e-maile i uruchomić makro (ALT+F8). W nowo otwartym oknie wybrać nasze makro i kliknąć przycisk Uruchom. Powyższe makro będzie zapisywało wszystkich nadawców e-maila w pliku C:/recipients.txt.


ok dzieki działa ale nie zupełnie. Zapisuje tylko nazwy nadawców a nie nazwy i ich adresy,np. zapisze mi janek W. a ja potrzebuje jeszcze np. janek@costam.pl. Jak to zmienić aby zapisywało w pliku recipients i nazwe i adres?
los_kowalos
 
Posty: 25
Dołączył(a): Pt 26.10.2007 11:04

Postprzez OShon » N 28.10.2007 23:08

mail.Recipients(1).Address
mail.Recipients(1).Name
Obrazek
Oskar Shon - MVP Office Dev. 11/21, 3x MCC, 4/9/22 TechNet
Forum moderator: Outlook.pl | ExcelForum.pl | MSDN dział VBA
Zobacz fajne dodatki: Outlooka, Excela, Worda lub PowerPointa
OShon
 
Posty: 10698
Dołączył(a): Cz 19.10.2006 08:31
Lokalizacja: Projekt autorski VBATools.pl

Postprzez los_kowalos » Pn 29.10.2007 07:23

OShon napisał(a):mail.Recipients(1).Address
mail.Recipients(1).Name


jak byś jeszcze napisał jak będzie wyglądał cały kod makro byłbym wdzięczny bo nie czaje o co w tym chodzi. Dzieki
los_kowalos
 
Posty: 25
Dołączył(a): Pt 26.10.2007 11:04

Postprzez Łukasz M. » Wt 30.10.2007 09:23

Kod: Zaznacz cały
Public Sub ZapiszNadawcow()
   
    Open "C:/recipients.txt" For Output As #1
   
    For Each oMail In Application.ActiveExplorer.Selection
        Set oReply = oMail.Reply
        Set oRecipients = oReply.Recipients
       
        For Each oRecip In oRecipients
            Print #1, oRecip.Name, oRecip.Address
        Next
    Next
   
    Close #1

End Sub
Łukasz M.
 
Posty: 95
Dołączył(a): Pt 03.08.2007 10:53
Lokalizacja: Jelenia Góra

Postprzez los_kowalos » Wt 06.11.2007 13:11

Łukasz M. napisał(a):
Kod: Zaznacz cały
Public Sub ZapiszNadawcow()
   
    Open "C:/recipients.txt" For Output As #1
   
    For Each oMail In Application.ActiveExplorer.Selection
        Set oReply = oMail.Reply
        Set oRecipients = oReply.Recipients
       
        For Each oRecip In oRecipients
            Print #1, oRecip.Name, oRecip.Address
        Next
    Next
   
    Close #1

End Sub


Kod ok tylko, że zapisuje w pliku tylko adres i to podwójnie a nie ma nazwy.
Nie wiem czy mnie zrozumiano. Mi chodzi o to, by móc wyciagnąć adresy i nazwy adresata poczty z pola nr 2 z oryginalnej wiadomości a nie jak do tej pory z pola nr 1. Foto poniżej:
http://www.los_kowalos.republika.pl/

z góry dzieki, pozdrawiam
los_kowalos
 
Posty: 25
Dołączył(a): Pt 26.10.2007 11:04

Postprzez Shon Oskar » Wt 06.11.2007 14:43

link nie ukazuje zdjecia
O'Shon
Shon Oskar
 
Posty: 182
Dołączył(a): Pn 16.10.2006 09:05
Lokalizacja: Veracomp S.A.

Postprzez los_kowalos » Wt 06.11.2007 14:46

Shon Oskar napisał(a):link nie ukazuje zdjecia


Spróbuj teraz. powinno pokazać, jak nie daj znak.
los_kowalos
 
Posty: 25
Dołączył(a): Pt 26.10.2007 11:04

Postprzez OShon » Cz 08.11.2007 23:12

Nie chce mi się szukać gdzie siedzą DO i DW wiec zrobiłem taką pętelkę która nie zrealizuje jak jej sie skończą elementy.

Pewnie za chwile to poprawie ale jak ci zależy na czasie to proszę. Działa dla wszystkich zaznaczonych. (dla OD również, a dla UDW oczywiście już nie)

Kod: Zaznacz cały
Sub Kontakty_ze_wskazanych_maili_zapisz()
Dim Item As MailItem
Dim x As Long
Dim MailAdres, oReply, oRecipients, oRecip

    Open "C:/recipients.txt" For Output As #1
        For Each Item In Application.ActiveExplorer.Selection
            Set MailAdres = Item
            Set oReply = Item.Reply
            Set oRecipients = oReply.Recipients
           
            For x = 1 To 100
                On Error Resume Next
                Print #1, MailAdres.Recipients(x).Name & "," & MailAdres.Recipients(x).Address
            Next x
       
             For Each oRecip In oRecipients
                Print #1, oRecip.Name & "," & oRecip.Address
             Next
        Next
    Close #1
Set MailAdres = Nothing
Set oReply = Nothing
Set oRecipients = Nothing
End Sub
Obrazek
Oskar Shon - MVP Office Dev. 11/21, 3x MCC, 4/9/22 TechNet
Forum moderator: Outlook.pl | ExcelForum.pl | MSDN dział VBA
Zobacz fajne dodatki: Outlooka, Excela, Worda lub PowerPointa
OShon
 
Posty: 10698
Dołączył(a): Cz 19.10.2006 08:31
Lokalizacja: Projekt autorski VBATools.pl

Postprzez los_kowalos » Pt 09.11.2007 10:07

Dzieki za kod. Działa. Ale oczywiście nie wyciąga adresów z pola 2 na zdjeciu http://www.los_kowalos.republika.pl/ a głównie o to mi chodziło. MAm nadzieje, że jeszcze coś wykombinujesz. Wielkie dzieki za to co do tej pory. Pozdro
los_kowalos
 
Posty: 25
Dołączył(a): Pt 26.10.2007 11:04

Postprzez Shon Oskar » Pt 09.11.2007 12:01

aa ok.
No jakoś przeoczyłem fakt że chcesz nie tylko ciągnąć z nagłówka ale z treści wiadomości.

Popracuje nad tym... i dam znać.
O'Shon
Shon Oskar
 
Posty: 182
Dołączył(a): Pn 16.10.2006 09:05
Lokalizacja: Veracomp S.A.

Postprzez los_kowalos » Pt 09.11.2007 12:23

OK :arrow: CZEKAM :beer:
los_kowalos
 
Posty: 25
Dołączył(a): Pt 26.10.2007 11:04

Postprzez OShon » Wt 13.11.2007 15:24

No już wszystko jest jasne.
Procedurka działa poprawnie na mailach HTML'owych

Kod: Zaznacz cały
Option Explicit

Sub Kontakty_ze_wskazanych_maili_zapisz()
Dim Item As MailItem
Dim x As Long
Dim MailAdres, oReply, oRecipients, oRecip
Dim PozP As Long, PozK As Long, Tekst As String, Tablica() As String, Licz As Long

    Open "C:/recipients.txt" For Output As #1
        For Each Item In Application.ActiveExplorer.Selection
            Set MailAdres = Item
            Set oReply = Item.Reply
            Set oRecipients = oReply.Recipients
           
            'adresy z nagłówka
            For Each oRecip In oRecipients
                Print #1, oRecip.Name & "," & oRecip.Address
            Next

            'adresy z odpowiedzi
            For x = 1 To MailAdres.Recipients.Count
                Print #1, MailAdres.Recipients(x).Name & "," & MailAdres.Recipients(x).Address
            Next x
           
            'adresy z treści
            Tekst = Item.Body
                PozP = InStr(1, Tekst, "mailto:", vbTextCompare)
               
            Do
                PozK = InStr(PozP, Tekst, """", vbTextCompare)
                Licz = Licz + 1
                ReDim Preserve Tablica(1 To Licz)
                Tablica(Licz) = Mid(Tekst, PozP + 7, PozK - PozP - 7)
                Tekst = Right(Tekst, Len(Tekst) - PozK)
                PozP = InStr(1, Tekst, "mailto:", vbTextCompare)
            Loop Until PozP = 0
       
            For x = 1 To Licz
                Print #1, Tablica(x)
            Next x
        Next
    Close #1
   
Set MailAdres = Nothing
Set oReply = Nothing
Set oRecipients = Nothing
End Sub


Może dorobię jeszcze aby przechwytywać z maili TXT,
jednakże jeśli adres składał sie z nazwy i z adresu to jego zamiana na TXT może uszkodzić adres pozostawiając tylko nazwę adresata.
Nic już sie z tym nie da zrobić.
Obrazek
Oskar Shon - MVP Office Dev. 11/21, 3x MCC, 4/9/22 TechNet
Forum moderator: Outlook.pl | ExcelForum.pl | MSDN dział VBA
Zobacz fajne dodatki: Outlooka, Excela, Worda lub PowerPointa
OShon
 
Posty: 10698
Dołączył(a): Cz 19.10.2006 08:31
Lokalizacja: Projekt autorski VBATools.pl

Postprzez los_kowalos » Śr 14.11.2007 08:18

Wielkie dzieki OShon :!: Pozdro
los_kowalos
 
Posty: 25
Dołączył(a): Pt 26.10.2007 11:04


Powrót do Microsoft Outlook

Kto przegląda forum

Użytkownicy przeglądający ten dział: Majestic-12 [Bot] i 13 gości