Posiadając listę (np. w MS Excel), której elementy zawierają hiperłącza typu „mailto” z adresami do odbiorców, mamy możliwość, po kliknięciu myszą, wygenerować wiadomość. Czynność ta jest wygodna w przypadku, kiedy ilość generowanych wiadomości przy użyciu tego modelu jest ograniczona, a treść wiadomości różna.
Rys 1. Przykład hiperłącza w MS Excel.
Kliknięte hiperłącze otwiera okno tworzenia nowej wiadomości, która jest uzupełniona adresem oraz tematem zawartym w linku. Wygenerowana wiadomość nie zawiera treści, toteż należy uzupełnić ją samodzielnie, i jest to jedyna dodatkowa czynność.
Można przypuszczać, iż w przypadku, kiedy użytkownik wysyła wiadomości o standardowej treści, można wyłączyć jej tworzenie na korzyść natychmiastowego wysłania (bez wyświetlenia). W tym celu niezbędna będzie modyfikacja wpisu rejestru:
Klucz:
HKEY_CLASSES_ROOT\mailto\shell\open\command\
Zamiast:
"C:\PROGRA~1\MICROS~2\Office\OUTLOOK.EXE" -c IPM.Note /m "%1"
Na:
"C:\PROGRA~1\MICROS~2\Office\OUTLOOK.EXE" /recycle /m "%1"
W systemach Vista/Windows 7 należy po zmianie ustawień w rejestrze uruchomić komputer ponownie. W programie Excel, gdzie znajdują się hiperłącza, w module arkusza wpisujemy poniższą procedurę:
Option Explicit
Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)
If InStr(1, Target.Address, "mailto") = 0 Then Exit Sub
Dim adres$: adres = Replace(Split(Target.Address, "?")(0), "mailto:", vbNullString)
Dim temat$: temat = Split(Target.Address, "subject=")(1)
Dim wyslano As Boolean
wyslano = Wysylanie_email(adres, temat)
If wyslano = False Then MsgBox "Problemy z wygenerowaniem wiadomości", _
vbExclamation, "O'Shon VBATools.pl"
End Sub
Function Wysylanie_email(ByVal adres$, ByVal temat$)
Dim OutApp As Object
Dim OutMail As Object
OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
OutMail = OutApp.CreateItem(0)
With OutMail
.To = adres
.Subject = Replace(temat, "%20", " ") 'mailto generuje URLEncode
.Body = "Treść wiadomości"
'.Display 'wyswietla
.Send 'wysyła
'.Save 'zapisuje w roboczych
End With
OutMail = Nothing
OutApp = Nothing
End
MVP Shon Oskar – VBATools.pl
Jeśli masz pytania dot. tego artykułu zapraszam na Forum
Skonfiguruj swój pakiet dodatków do Excela, Worda, PowerPointa i Outlooka
© Wszelkie prawa zastrzeżone. Żadna część ani całość tego artykułu nie może być powielana ani publikowana bez zgody autora.