VBATools

Często problemem, zwłaszcza młodych ludzi ogarniętych zapałem jak i chęcią wykonania zadań w jak najkrótszym czasie, jest „roztargnienie” podczas wysyłania wiadomości z załącznikami. Często wysłane wiadomości nie zawierają załączników, choć powinny.

W dość prosty sposób można zabezpieczyć się przed tą dość krępującą sytuacją umieszczając poniższy kod w module klasy ThisOutlookSession.

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
'MVP OShon from VBATools.pl
Dim oMail As MailItem, kom
If Item.Class = 43 Then 
 Set 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
End If
End Sub

W przypadku nadania wiadomości do adresata „Monika” z tematem zawierającym słowo „Raport” bez załączników otrzymujemy ekran z zapytaniem:

Rys 1. Ekran z zapytaniem o dalsze losy wiadomości bez załącznika.

Możemy rozwinąć pow. kod, aby nadanie wiadomości bez załącznika wymusiło wskazanie pliku, który będzie dołączony do wiadomości.

Należy dodać w developerze Outlooka kontrolkę Excela oraz umieścić poniższą procedurę zamiast poprzednio wymienionej.

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
'MVP OShon from VBATools.pl
Dim oMail As MailItem, kom, x&
Dim xApp As New Excel.Application
Dim fileName As Variant

If Item.Class = 43 Then 
Set 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

Rys 2. Ekran z zapytaniem o pliki załącznika.

Tak, oznaczać będzie wyświetlenie okna wskazania plików (rys 3). Anulowanie komunikatu przerwie procedurę nadania wiadomości.

Rys 3. Podpinanie plików do wiadomości.

Z przytrzymaniem przycisku Ctrl można podpiąć dowolne pliki, jako załączniki wiadomości.

Rys 4. Wskazane wcześniej załączniki dołączone przed nadaniem wiadomości.

Ostatni rys w tym artykule przedstawia załączniki wiadomości zaraz przed wysłaniem.

Errata dotycząca wersji 2013.

W niej obrazki dołączone do wiadomości (np w podpisie) są traktowane podobnie jak załączniki. To też należy wziąć to pod uwagę i zwiększyć ilość podczas warunku oMail.Attachments.Count = 0. Wartość tą należy odpowiednio zwiększyć.

(c) Shon Oskar – www.VBATools.pl