VBA Tools

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

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.