VBATools

Pobranie adresu email z treści wiadomości

by on Oct.10, 2011, under Outlook, Porady

W poniższej poradzie podaje możliwość pobrania do późniejszego wykorzystania osadzonych w treści wiadomości adresów email.

Funkcja zwracająca pierwszy adres z treści wiadomości oraz następna funkcja zwracająca wszystkie adresy email w standardzie zgodnym “do odpowiedzi”:

Function zwracaj_pierwszy_email_z_tresci(tresc$) As String
'MVP OShon from VBATools.pl
Dim tabela As Variant, x&, mail$
If InStr(1, tresc, "@") > 0 Then
 tabela = Split(oczysc(tresc), " ")
 For x = 1 To UBound(tabela)
 If tabela(x) Like "*@*.*" Then
 zwracaj_pierwszy_email_z_tresci = tabela(x)
 Exit Function
 End If
 Next x
End If
End Function

Function zwracaj_wszystkie_adresy_z_tresci(tresc$) As String
'MVP OShon from VBATools.pl
Dim tabela As Variant, x&, el As Variant
Dim Nodupes As New Collection
If InStr(1, tresc, "@") > 0 Then
 tabela = Split(oczysc(tresc), " ")
 For x = LBound(tabela) To UBound(tabela)
 If tabela(x) Like "*@*.*" Then
 On Error Resume Next
 Nodupes.Add tabela(x), CStr(tabela(x))
 On Error GoTo 0
 End If
 Next x
 For Each el In Nodupes
 zwracaj_wszystkie_adresy_z_tresci = _
 zwracaj_wszystkie_adresy_z_tresci & el & ";"
 Next
End If
End Function

Private Function oczysc(tresc$) As String
 tresc = Replace(tresc, "[", " ")
 tresc = Replace(tresc, ":", " ")
 tresc = Replace(tresc, "]", " ")
 tresc = Replace(tresc, ";", " ")
 tresc = Replace(tresc, Chr(13), " ")
 tresc = Replace(tresc, vbTab, " ")
 oczysc = Replace(tresc, """", " ")
End Function

Testowo możemy sprawdzić działanie funkcji wywołując poniższą procedurę:

Sub Testy()
Dim MyItem As MailItem
Select Case TypeName(Application.ActiveWindow)
 Case "Explorer":  Set MyItem = ActiveExplorer.Selection.item(1)
 Case "Inspector": Set MyItem = ActiveInspector.CurrentItem
 Case Else
End Select
Debug.Print zwracaj_pierwszy_email_z_tresci(MyItem.Body)
Debug.Print zwracaj_wszystkie_adresy_z_tresci(MyItem.Body)
End Sub

Wynik zwrócony jest w oknie immediate [Ctrl+G] środowiska developerskiego VBA.

(c) Shon Oskar – www.VBATools.pl

Wszelkie prawa zastrzeżone. Żadna część ani całość tego artykułu nie może być powielana ani publikowana bez zgody autora.

:, , , , ,

Leave a Reply

Recently Active Members

Profile picture of vbatools
Profile picture of Karol Stilger
Profile picture of Joanna Subik
Profile picture of Anorak
Profile picture of marcinmachalowski
Profile picture of programistaaccess
Profile picture of piotrpawlik
Profile picture of Emil Wasilewski
Profile picture of kicekpicek
Profile picture of coldfusion
Profile picture of Gosia Borzęcka
Profile picture of lukaszch
Profile picture of itadministracja
Profile picture of farbenia
Profile picture of Łukasz Kałużny
Profile picture of kabzinski
Profile picture of rtynski
Profile picture of leszekbetlinski
Profile picture of Iv
Profile picture of Justyna Spychała