Promemoria allegati per Outlook - aggiornamento

Sulla scia del suggerimento di djfede ripubblico il codice aggiornato per Outlook. Con la modifica, viene segnalato un avviso nel caso in cui non sia presente un allegato ma nel corpo della mail ci sia la radice "alleg" o "attach".

Il post originale, comprensivo di citazione per l'autore della macro (no, non sono io), è qui.

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
Dim m As Variant
Dim strBody As String
Dim intIn As Integer, intAttachCount As Integer
Dim x As Integer

On Error GoTo handleError

intAttachCount = 0

strBody = LCase(Item.Body)

intIn = InStr(1, strBody, "original message")

If intIn = 0 Then intIn = Len(strBody)

intIn = InStr(1, Left(strBody, intIn), "alleg") + InStr(1, Left(strBody, intIn), "attach")

If intIn > 0 Then

For x = 1 To Item.Attachments.Count
If LCase(Item.Attachments.Item(x).DisplayName) <> "picture (metafile)" Then
intAttachCount = intAttachCount + 1
End If
Next

If intAttachCount = 0 Then

m = MsgBox("Sembra proprio che tu voglia mandare un allegato," & vbCrLf & "ma non ci sono allegati in questo messaggio." & vbCrLf & vbCrLf & "Desideri inviarlo comunque?", vbQuestion + vbYesNo + vbMsgBoxSetForeground)

If m = vbNo Then Cancel = True

End If

End If

handleError:

If Err.Number <> 0 Then
MsgBox "Outlook Attachment Reminder Error: " & Err.Description, vbExclamation, "Outlook Attachment Reminder Error"
End If

End Sub

Powered by Qumana