发送没有附件的电子邮件时弹出消息 [英] Popup msg while sending email without attachment

问题描述

如果我们使用附件，封闭，pfa等字样，我已经搜索了以下代码，以便在没有附件的情况下发送电子邮件提醒。 br />
我在ThisOutlookSession of outlook中编写了这段代码。

 私人  Sub  Application_ItemSend（ ByVal  Item  As  对象，取消作为 布尔）
  Dim  intIn  As   Long  
 
 intIn =  0  
  Dim  wrds 作为 字符串 
 strBody = LCase（Item.Subject）& LCase（Item.Body）
 设置 Rgx = CreateObject（  vbscript.regexp）
 Rgx.Pattern = wrds 
 Rgx。全局 =  True  
 Rgx.IgnoreCase =  True  
 设置 allMatches = Rgx.Execute（strBody）
 intLength = InStr（ 1 ，strBody，  from：）
 
 如果 intLength =  0  然后 intLength = Len（strBody）
 
 如果 intIn =  0  然后 intIn = InStr（ 1 ，Left（strBody，intLength），  pfa ）
 如果 intIn =  0  然后 intIn = InStr（ 1 ，左（strBody，intLength）， < span class =code-string> PFA）
 如果 intIn =  0  然后 intIn = InStr（ 1 ，左（strBody，intLength），  attach）
 如果 intIn =  0  然后 intIn = InStr（ 1 ，左（strBody） ，intLength）， 随附）
 如果 intIn =  0  那么 intIn = InStr（ 1 ，Left（strBody，intLength）， 封闭）
 如果 intIn =  0  那么 intIn = InStr（ 1 ，左（strBody，intLength），  attachment）
 如果 intIn =  0  那么 intIn = InStr（ 1 ，左（strBody，intLength），  attach）
 intAttachCount = Item.Attachments.Count 
  If  intIn>  0  和 intAttachCount< = intStandardAttachCount 然后 
m = MsgBox（ 看起来您忘了附加文件...... _ 
& vbNewLine& vbNewLine& _ 
  是否仍要发送此消息？，_ 
 vbYesNo + vbDefaultButton2 + vbExclamation + vbMsgBoxSetForeground， 附件丢失？）
 如果 m = vbNo 那么 
取消=  True  
  GoTo  ExitSub 
 结束 如果 
 结束 如果 
 
 ExitSub：
 设置项目= 无 
 strBody =   
 退出  Sub  
 
 结束  Sub  

代码工作正常。实际上它只在测试代码时有效。一段时间后它停止工作。

当我在其他电脑上尝试相同的代码时，它失败了。任何帮助都赞赏。



问候，

Archie

解决方案

你的代码看起来不错，但你需要知道一些事情......用几句话很难回答，所以我会建议你阅读以下文章：

了解Outlook中的事件 [ ^ ]

使用Outlook事件 [ ^ ]

在Auto中使用事件mation [ ^ ] - 最重要的！

使用Outlook Visual Basic for Applications响应Outlook事件 [ ^ ]

了解Outlook中的VBA [ ^ ]

在Outlook 2010中开始使用VBA [ ^ ]

Hi,

I have searched the below code for giving reminder if email is sent without attachement if we use words like attached, enclosed, pfa, etc.
I have written this code in ThisOutlookSession of outlook.

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

intIn = 0
    Dim wrds As String
strBody = LCase(Item.Subject) & LCase(Item.Body)
Set Rgx = CreateObject("vbscript.regexp")
    Rgx.Pattern = wrds
    Rgx.Global = True
    Rgx.IgnoreCase = True
    Set allMatches = Rgx.Execute(strBody)
intLength = InStr(1, strBody, "from:")

If intLength = 0 Then intLength = Len(strBody)

If intIn = 0 Then intIn = InStr(1, Left(strBody, intLength), "pfa")
If intIn = 0 Then intIn = InStr(1, Left(strBody, intLength), "PFA")
If intIn = 0 Then intIn = InStr(1, Left(strBody, intLength), "attached")
If intIn = 0 Then intIn = InStr(1, Left(strBody, intLength), "enclosed")
If intIn = 0 Then intIn = InStr(1, Left(strBody, intLength), "enclosing")
If intIn = 0 Then intIn = InStr(1, Left(strBody, intLength), "attachment")
If intIn = 0 Then intIn = InStr(1, Left(strBody, intLength), "attach")
intAttachCount = Item.Attachments.Count
If intIn > 0 And intAttachCount <= intStandardAttachCount Then
m = MsgBox("It looks like you forgot to attach a file... " _
& vbNewLine & vbNewLine & _
"Do you still want to send this message? ", _
vbYesNo + vbDefaultButton2 + vbExclamation + vbMsgBoxSetForeground, "Attachment Missing?")
If m = vbNo Then
Cancel = True
GoTo ExitSub
End If
End If

ExitSub:
Set Item = Nothing
strBody = ""
Exit Sub

End Sub

The code was working fine.Infact it works only for sometime while testing the code. After sometime it stops working.
When i try this same code on other pc it fails.Any help appreciated.

Regards,
Archie

解决方案

Your code looks good, but you need to know something... It is hard to answer in few words, so i would suggest you to read below articles:
Understanding Events in Outlook[^]
Working with Outlook events[^]
Using events with Automation[^] - the most important!
Using Outlook Visual Basic for Applications to respond to Outlook events[^]
Understanding VBA in Outlook[^]
Getting Started with VBA in Outlook 2010[^]

这篇关于发送没有附件的电子邮件时弹出消息的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！