VBA Tools

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
Exit 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.

(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.