Bijlage Niet Vergeten

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
'
' Volgens http://pubs.logicalexpressions.com/Pub0009/LPMArticle.asp?ID=341
' (c) Bas Ovink
'
  If Item.Class <> olMail Then Exit Sub
  If Item.Attachments.Count > 0 Then Exit Sub
  If Not SearchForAttachWords(Item.Subject & ":" & Item.Body) Then Exit Sub
  If UserWantsToAttach Then
      ExecuteInsertFileCommand
      Cancel = True
  End If
End Sub

Function SearchForAttachWords(ByVal s As String) As Boolean
  Dim v As Variant
  For Each v In Array("attach", "aangehecht", "bijgevoegd", "bijvoeg", "bij deze", "bijlage", "bijgaande")
    If InStr(1, s, v, vbTextCompare) <> 0 Then
      SearchForAttachWords = True
      Exit Function
    End If
  Next
End Function

Function UserWantsToAttach() As Boolean
  If MsgBox("The text of this message suggests an attachment, however no file has been attached yet." _
      & vbCrLf & vbCrLf & _
      "Do you wish to attach a file?", _
      vbQuestion + vbYesNo) _
      = vbYes Then
    UserWantsToAttach = True
  End If
End Function

Sub ExecuteInsertFileCommand()
On Error Resume Next 'Dirty trick to accept Office NL and UK
  Application.ActiveInspector.CommandBars("Standard").Controls("&File...").Execute
  Application.ActiveInspector.CommandBars("Standard").Controls("&Bestand...").Execute
On Error GoTo 0
End Sub