i found this code, how can i modify it, because even there's not a word attachment keep saying i forgot the attachment,
it works fine, it ask about attachment every time i sent an email, even though there's no keywords for attachment.
here is the code:
- Code: Select all
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
Dim bCancelSend As Boolean
Dim sTextToSearch As String
Dim vSearchForWord(2) As String 'used as keyword list for attachment check
Dim iStartOfQuote As Long
Dim iAttachmentCount As Long
Dim i As Long
'CHECK FOR BLANK SUBJECT LINE
If Item.Subject = "" Then
bCancelSend = MsgBox("This message does not have a subject." & vbNewLine & _
"Do you wish to continue sending anyway?", _
vbYesNo + vbExclamation, "No Subject") = vbNo
End If
'CHECK BODY AND SUBJECT FOR ATTACMENT KEYWORDS.
'Set TextToSearch variable to message Body based on message type
'and find start of quoted text.
Select Case Item.BodyFormat
Case olFormatHTML
iStartOfQuote = InStr(Item.HTMLBody, "<DIV class=OutlookMessageHeader") - 1
sTextToSearch = Item.HTMLBody
Case olFormatRichText
iStartOfQuote = InStr(Item.Body, "_____________________________________________") - 1
sTextToSearch = Item.Body
Case olFormatPlain
iStartOfQuote = InStr(Item.Body, "-----Original Message-----") - 1
sTextToSearch = Item.Body
End Select
'
'Need to add code to get count of embedded attachments vs non-embedded attachments.
'If user has a signature file with an image of it Attachments.Count counts it as an attachment
'SuedoCode:
'iAttachmentCount = (Item.Attachments.Count - EmbeddedAttchments.Count)
'
'Adjust TextToSearch if there is quoted text
If iStartOfQuote > 0 Then sTextToSearch = Left(sTextToSearch, iStartOfQuote)
'Add subject to search text
sTextToSearch = sTextToSearch & " " & Item.Subject
If Not bCancelSend Then
If iAttachmentCount = 0 Then
'Check for attachment keywords.
'Use lowercase keywords.
vSearchForWord(0) = "attach" 'finds attached, attachment & attaching
vSearchForWord(1) = "enclosed"
vSearchForWord(2) = "here it is"
For i = LBound(vSearchForWord) To UBound(vSearchForWord)
If InStr(LCase(sTextToSearch), vSearchForWord(i)) > 0 Then
bCancelSend = MsgBox("It appears you were going to send an attachment but nothing is attached." & vbNewLine & _
"Do you wish to continue sending anyway?", _
vbYesNo + vbExclamation, "Attachment Not Found") = vbNo
Exit For
End If
Next i
End If
End If
'Cancel sending message if answered yes to either message box.
Cancel = bCancelSend
End Sub
thank you