请各位高手帮帮我,不胜感激!

dmnzhuch · 发表于 2009-3-12 13:45

我看见有人发了个检查邮件是否添加附件的插件,我觉的太棒了,
由于我门单位邮件群发的时候对附件的大小有限制,附件过大会造成局域网堵塞,
我希望各位高手可以帮我写一个邮件附件大小超出提醒的插件,

就在以下编码中完善就好了,我会万分感激的!
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
Dim lngres As Long
'检查邮件是否添加附件
If InStr(1, Item.Body, "附件") <> 0 Then
If Item.Attachments.Count = 0 Then
Application.Explorers(1).Activate
lngres = MsgBox("邮件内容中包含“附件”，但是没有发现附件！" & Chr(10) & "仍然发送？", _
vbYesNo + vbDefaultButton2 + vbQuestion, "提示")

If lngres = vbNo Then
Cancel = True
Item.Display
Exit Sub
End If

End If
End If

'检查是否写主题
If Item.Subject = "" Then
Application.Explorers(1).Activate
lngres = MsgBox("邮件还没有写主题呢！" & Chr(10) & "仍然发送？", _
vbYesNo + vbDefaultButton2 + vbQuestion, "提示")
If lngres = vbNo Then
Cancel = True
Item.Display
Exit Sub
End If
End If
End Sub

roof · 发表于 2009-3-12 23:42

大概改了一下，邮件超过50K就会提示。自己根据需要修改大小。

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
Dim lngres As Long
'检查邮件是否添加附件

If InStr(1, Item.Body, "附件") <> 0 Then
If Item.Attachments.Count = 0 Then

      Application.Explorers(1).Activate
      lngres = MsgBox("邮件内容中包含“附件”，但是没有发现附件！" & Chr(10) & "仍然发送？", _
      vbYesNo + vbDefaultButton2 + vbQuestion, "提示")

      If lngres = vbNo Then
         Cancel = True
         Item.Display
         Exit Sub
      End If

      Item.Save '必须先保存邮件，才能检测到邮件的大小。

   If Item.Size > 51200 Then '51200 byte 除以1024 = 50K
         Application.Explorers(1).Activate
         lngres = MsgBox("邮件大于50K！" & Chr(10) & "仍然发送？", _
         vbYesNo + vbDefaultButton2 + vbQuestion, "提示")
            If lngres = vbNo Then
                  Cancel = True
                  Item.Display
                  Exit Sub
            End If
      End If
End If

End If

'检查是否写主题
If Item.Subject = "" Then
Application.Explorers(1).Activate
lngres = MsgBox("邮件还没有写主题呢！" & Chr(10) & "仍然发送？", _
vbYesNo + vbDefaultButton2 + vbQuestion, "提示")

If lngres = vbNo Then
Cancel = True
Item.Display
Exit Sub
End If

End If
End Sub

[ 本帖最后由 roof 于 2009-3-12 23:43 编辑 ]

dmnzhuch · 发表于 2009-3-13 09:29

原帖由 roof 于 2009-3-12 23:42 发表
大概改了一下，邮件超过50K就会提示。自己根据需要修改大小。

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
Dim lngres As Long
'检查邮件是否添加附件

If InStr(1, Item.Bo ...

谢谢你!
不过好象不行,我试发了个2MB,没提示就发了,而且是保存了后发的

roof · 发表于 2009-3-13 10:34

大概改了一下，邮件超过50K就会提示。自己根据需要修改大小。

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
Dim lngres As Long
'检查邮件是否添加附件

If InStr(1, Item.Body, "附件") <> 0 Then
If Item.Attachments.Count = 0 Then

      Application.Explorers(1).Activate
      lngres = MsgBox("邮件内容中包含“附件”，但是没有发现附件！" & Chr(10) & "仍然发送？", _
      vbYesNo + vbDefaultButton2 + vbQuestion, "提示")

      If lngres = vbNo Then
         Cancel = True
         Item.Display
         Exit Sub
      End If

End If

End If

'检查是否写主题
If Item.Subject = "" Then
Application.Explorers(1).Activate
lngres = MsgBox("邮件还没有写主题呢！" & Chr(10) & "仍然发送？", _
vbYesNo + vbDefaultButton2 + vbQuestion, "提示")

If lngres = vbNo Then
Cancel = True
Item.Display
Exit Sub
End If

End If

Item.Save '必须先保存邮件，才能检测到邮件的大小。

   If Item.Size > 51200 Then '51200 byte 除以1024 = 50K
         Application.Explorers(1).Activate
         lngres = MsgBox("邮件大于50K！" & Chr(10) & "仍然发送？", _
         vbYesNo + vbDefaultButton2 + vbQuestion, "提示")
            If lngres = vbNo Then
                  Cancel = True
                  Item.Display
                  Exit Sub
            End If
      End If
End Sub

[ 本帖最后由 roof 于 2009-3-13 10:50 编辑 ]

dmnzhuch · 发表于 2009-3-13 11:26

原帖由 roof 于 2009-3-13 10:34 发表
大概改了一下，邮件超过50K就会提示。自己根据需要修改大小。

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
Dim lngres As Long
'检查邮件是否添加附件

If InStr(1, Item.Bo ...

可以用了,非常感谢你的帮助!!

roof · 发表于 2009-3-17 10:11

忽然想起，如果邮件比较大的话（超过1兆？），可以考虑用mailitem的DeferredDeliveryTime属性把发件时间推迟到凌晨非繁忙时段。未经测试，请在单位用outlook的朋友测试一下。我们单位用的是lotus note，有类似功能，但是不知道是否是在服务器端运行代码实现的。

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
Dim lngres As Long
'检查邮件是否添加附件

If InStr(1, Item.Body, "附件") <> 0 Then
If Item.Attachments.Count = 0 Then

      Application.Explorers(1).Activate
      lngres = MsgBox("邮件内容中包含“附件”，但是没有发现附件！" & Chr(10) & "仍然发送？", _
      vbYesNo + vbDefaultButton2 + vbQuestion, "提示")

      If lngres = vbNo Then
         Cancel = True
         Item.Display
         Exit Sub
      End If

End If

End If

'检查是否写主题
If Item.Subject = "" Then
Application.Explorers(1).Activate
lngres = MsgBox("邮件还没有写主题呢！" & Chr(10) & "仍然发送？", _
vbYesNo + vbDefaultButton2 + vbQuestion, "提示")

If lngres = vbNo Then
Cancel = True
Item.Display
Exit Sub
End If

End If

Item.Save '必须先保存邮件，才能检测到邮件的大小。

   If Item.Size > 1048576 Then '1兆=1024*1024=1048576byte
         Application.Explorers(1).Activate
         lngres = MsgBox("邮件大于1兆！" & Chr(10) & "单击<是>把发送时间将安排在明天凌晨1点，单击<否>返回修改邮件。", _
         vbYesNo + vbDefaultButton2 + vbQuestion, "提示")
            If lngres = vbNo Then
                  Cancel = True
                  Item.Display
                  Exit Sub
            Else
            Item.DeferredDeliveryTime = DateAdd("h",1, Date +1) '将发送时间定为次日凌晨1点，但愿你没有凌晨1点钟发大邮件的习惯，否则邮件要等20多个小时后才会发出。
            End If
      End If
End Sub

[ 本帖最后由 roof 于 2009-3-17 10:45 编辑 ]

aaaaabbbbb · 发表于 2009-3-25 23:24

不错,值得学习.

新新软件 · 发表于 2011-1-18 14:56

不错，正好需要赶快下载下来！

		自动登录	找回密码
密码			免费注册

[求助] 请各位高手帮帮我,不胜感激!

回复 3楼 dmnzhuch 的帖子

评分

回复 5楼 dmnzhuch 的帖子