Ostrzeżenie o braku załącznika

Czasami zdarza się, że podczas wysyłania emaila zapominamy dodać do niego załącznik. Można tego jednak łatwo uniknąć umieszczając poniższy kod makra w module klasy ThisOutlookSession edytora VB. 

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
    Dim oMail As MailItem, kom
    If Item.Class = 43 Then oMail = Item
    If InStr(1, LCase(oMail.To), LCase("Monika")) > 0 And _
       InStr(1, LCase(oMail.Subject), LCase("Raport")) > 0 And _
       oMail.Attachments.Count = 0 Then
        kom = MsgBox("Nie dołączono raportu." & vbCr & _
                     "Czy chcesz przerwać nadanie tej wiadomości?", _
                      vbYesNo + vbDefaultButton1 + vbQuestion, _
                     "Ostrzeżenie o braku załącznika VBATools.pl")
        If kom = vbYes Then Cancel = True : Exit Sub
    End If
    Exit Sub

W przypadku wysłania wiadomości bez załączników do adresata Monika z tematem zawierającym słowo Raport zostanie wyświetlone okno z zapytaniem (Rys.1.):

Rys.1. Ekran pojawiający się podczas wysyłania wiadomości. 

Możemy dodatkowo rozwinąć powyższy kod tak, aby wysyłanie wiadomości bez załącznika wymusiło wskazanie pliku, który będzie dołączony do emaila.

Aby to zrobić należy dodać w developerze Outlooka kontrolkę Excela oraz umieścić poniższą procedurę zamiast powyższej.

Private Sub Application_ItemSend(ByVal Item As Object, ByVal Cancel As Boolean)
    Dim oMail As MailItem, kom, x&
    Dim xApp As New Excel.Application
    Dim fileName As Object

    If Item.Class = 43 Then oMail = Item
    If InStr(1, LCase(oMail.To), LCase("Monika")) > 0 And _
       InStr(1, LCase(oMail.Subject), LCase("Raport")) > 0 And _
       oMail.Attachments.Count = 0 Then
        kom = MsgBox("Nie dołączono raportu." & vbCr & _
                     "Czy chcesz podpiąć pliki do wiadomości?", _
                      vbYesNoCancel + vbDefaultButton1 + vbQuestion, _
                     "Ostrzeżenie o braku załącznika VBATools.pl")

        If kom = vbYes Then
            fileName = xApp.GetOpenFilename(FileFilter:="Wszystkie pliki (*.*),*.*", _
                                       Title:="Wybierz pliki załącznika", _
                                       MultiSelect:=True)
            If Not IsArray(fileName) Then
                MsgBox("Nie wybrano żadnego pliku.") : Exit Sub
            Else
                For x = LBound(fileName) To UBound(fileName)
                    oMail.Attachments.Add(fileName(x))
                Next x
                oMail.Save()
            End If
        ElseIf kom = vbCancel Then
            Cancel = True
        End If
    End If
End Sub

Po zastosowaniu powyższego kodu przy próbie wysłania wiadomości bez załączników pojawi się poniższe okno (Rys.2.):

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.