Pobranie adresu email z treści wiadomości
by vbatools 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.