Outlook2010 发送附件检查

mzp320123

下代码不能正常检查，请高手帮助看看，谢谢~~

Private Declare Function MsgBoxEx Lib "user32" Alias "MessageBoxTimeoutA" ( _

    ByVal hwnd As Long, _

    ByVal lpText As String, _

    ByVal lpCaption As String, _

    ByVal wType As VbMsgBoxStyle, _

    ByVal wlange As Long, _

    ByVal dwTimeout As Long) As Long

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)

If TypeName(Item) <> "MailItem" Then Exit Sub

Dim intRes As Integer

Dim strMsg As String

Dim strThismsg As String

Dim intOldmsgstart As Integer

Dim sSearchStrings(2) As String

Dim bFoundSearchstring As Boolean

Dim i As Integer ' loop var for FOR-NEXT-loop

Dim intDeferStyle As Integer

Dim intDeferTime As Integer

Dim intMailImportance As Integer

Dim bDeferImportance As Boolean

bFoundSearchstring = False

intMailImportance = Item.Importance

'设定附件提醒的相关参数

sSearchStrings(0) = "attach" '正文或标题包含的关键字，当找到这些关键字时，就认定邮件应该带附件

sSearchStrings(1) = "enclose" '可以设定多个关键字，但记得在“Dim sSearchStrings(2) As String”语句中更改数组上限

sSearchStrings(2) = "附件"

'延时发送相关参数，可以更改

intDeferStyle = 1 '延时发送的模式，0=不延时发送，1=跳出倒计时对话框，2=采用outlook自带的延时发送属性DeferredDeliveryTime

intDeferTime = 10 '延时发送的时间，单位秒

bDeferImportance = False '重要性为高的邮件是否也延时发送，0=重要性高的邮件不延时，1=重要性高的邮件也延时

If bDeferImportance Then

    intMailImportance = 1

End If

'检查附件

intOldmsgstart = InStr(Item.Body, "-----Original Message-----")

If intOldmsgstart = 0 Then

    strThismsg = Item.Body + " " + Item.Subject

Else

    strThismsg = Left(Item.Body, intOldmsgstart) + " " + Item.Subject

End If

For i = LBound(sSearchStrings) To UBound(sSearchStrings)

    If InStr(LCase(strThismsg), sSearchStrings(i)) > 0 Then

        bFoundSearchstring = True

        Exit For

    End If

Next i

If bFoundSearchstring Then

    If Item.Attachments.Count = 0 Then

        strMsg = "Attachment Checker:" & Chr(13) & Chr(10) & "邮件内容提到了附件，但没有找到任何附件！" & Chr(13) & Chr(10) & "确定不添加附件吗？"

        intRes = MsgBox(strMsg, vbYesNo + vbDefaultButton2 + vbExclamation, "You forgot the attachment!")

        If intRes = vbNo Then

            ' cancel send

            Cancel = True

        End If

    End If

End If

'延时发送

If intDeferStyle = 1 And intMailImportance <> 2 Then

    '弹出倒计时对话框的方式，实现延时发送

    strMsg = intDeferTime & "秒后发送邮件" & Chr(13) & Chr(10) & "马上发送请点确定，后悔请点取消，否则耐心等待"

    intRes = MsgBoxEx(0, strMsg, "延时发送邮件", vbYesNo + vbInformation, 1, intDeferTime * 1000)

    If intRes = vbNo Then

        Cancel = True

    End If

ElseIf intDeferStyle = 2 And intMailImportance <> 2 Then

    '采用outlook自带的DeferredDeliveryTime属性实现延时发送，有些小问题，很难控制10秒后准确发送，请高手解决，菜鸟可以用第一种延时发送方式

    Item.DeferredDeliveryTime = DateAdd("s", intDeferTime, Now)

   

End If

End Sub