Outlook Macro source code

This post is created only for the code, so that I can keep updating it.
The instructions are in other posts.
I do not take credit for this code. Original code for Attachment reminder available here. I merely combined this with Reminder for missing subject. Similar code is available easily just by Googling.

*Update: Outlook counts files used in Signatures as attachments. see here.

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
Dim strSubject As String
Dim m As Variant
Dim strBody As String
Dim intIn As Integer, intAttachCount As Integer
Dim x As Integer
 
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), "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("It appears that you mean to send an attachment," & vbCrLf & "but there is no attachment to this message." & vbCrLf & vbCrLf & "Do you still want to send?", vbQuestion + vbYesNo + vbMsgBoxSetForeground)
     
            If m = vbNo Then
                Cancel = True
                Exit Sub
            End If
        End If
    End If
End If
 
strSubject = Item.Subject
If Len(Trim(strSubject)) = 0 Then
    Prompt$ = "Subject is Empty. Are you sure you want to send the Mail?"
    If MsgBox(Prompt$, vbYesNo + vbQuestion + vbMsgBoxSetForeground, "Check for Subject") = vbNo Then
        Cancel = True
    End If
End If
 
End Sub