Wyłączenie tworzenia wiadomości do edycji po kliknięciu na hiperłącze "mailto"

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 On

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

 

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.