用vba编写outlook邮件发送时的一个检查各项信息的功能

琬心婆婆

求助！！在做业务时，。每天都要用outlook给不同的客户发送邮件，每次发送邮件的时候都要注意收件人是否正确，CC的人是否正确，主体是否正确，附件加的对不对，附件的大小是否超过1M。有时候稍不留神就有发错的可能，一旦发错小女子我就会被骂的狗血临头，这滋味太难受了{:soso_e109:} 所以我想到能不能用vba语言编写一个程序，在每次邮件写好点发送时能弹出一个对话框，上面有本次邮件的收件人、CC、主题、附件和附件大小的信息，并询问是否继续发送。这样就能大大减少错误的发生。无奈小女子水平有限，写不出这么复杂的代码。求高手指点迷津！！

琬心婆婆

文中“主体”换成“主题”{:soso_e127:}

dsd999

你是否已经写了一些代码了，放上来看看，我帮你改改。

琬心婆婆

dsd999 发表于 2012-4-17 09:17
你是否已经写了一些代码了，放上来看看，我帮你改改。

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
Dim lngres As Long
Item.Save '必须先保存邮件，才能检测到邮件的大小。
         
        If Item.Size > 1048576 Then '1048576 byte 除以1024 = 1M
             Application.Explorers(1).Activate
             lngres = MsgBox("邮件大于1M！" & Chr(10) & "仍然发送？", _
             vbYesNo + vbDefaultButton2 + vbQuestion, "提示")
                 If lngres = vbNo Then
                     Cancel = True
                     Item.Display
                     Exit Sub
                 End If
         End If
End Sub

我只会一个检查附件的，其余的都不会写，求指点！

dsd999

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
Dim lngres As Long
Item.Save '必须先保存邮件，才能检测到邮件的大小。
         
        If Item.Size > 1048576 Then '1048576 byte 除以1024 = 1M
             Application.Explorers(1).Activate
             lngres = MsgBox("邮件大于1M！" & Chr(10) & "仍然发送？", _
             vbYesNo + vbDefaultButton2 + vbQuestion, "提示")
                 If lngres = vbNo Then
                     Cancel = True
                     Item.display
                     Exit Sub
                 End If
         End If
         
         lngres = MsgBox("收件人" & Chr(10) & Item.To, _
             vbYesNo + vbDefaultButton2 + vbQuestion, "提示")
                 If lngres = vbNo Then
                     Cancel = True
                     Item.display
                     Exit Sub
                 End If
                 
        lngres = MsgBox("抄送" & Chr(10) & Item.CC, _
             vbYesNo + vbDefaultButton2 + vbQuestion, "提示")
                 If lngres = vbNo Then
                     Cancel = True
                     Item.display
                     Exit Sub
                 End If
                 
    lngres = MsgBox("主题" & Chr(10) & Item.Subject, _
             vbYesNo + vbDefaultButton2 + vbQuestion, "提示")
                 If lngres = vbNo Then
                     Cancel = True
                     Item.display
                     Exit Sub
                 End If
                 
                 
End Sub

琬心婆婆

dsd999 发表于 2012-4-24 15:28
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
Dim lngres As Long
Item. ...

十分感谢啊！！帮了大忙了！！学到了很多东西啊！！我还想请教一个问题，在判断附件的大小时，我想先判断附件的格式，如果是压缩文件就可以发送，如果不是压缩文件就弹出提示“不可发送”，然后就让它发不出去。这个该怎么做呢？我不知道怎么判断文件的格式。请指教！多谢多谢！

dsd999

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
Dim lngres As Long
Item.Save '必须先保存邮件，才能检测到邮件的大小。
Dim aa As Integer
aa = InStr(1, Item.Attachments(1).filename, "rar") + _
    InStr(1, Item.Attachments(1).filename, "zip")
         
         If aa = 0 Then
            MsgBox "不是压缩文件，不能发送"
            Cancel = True
            Item.display
             Exit Sub
         End If
End Sub

琬心婆婆

dsd999 发表于 2012-4-25 08:58
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
Dim lngres As Long
Item. ...

学到了很多！！多谢了！！以后还会多多请教！

飘舞的飞絮

各位大侠，求助一下，OUTLOOK2010,VBA定时发送的代码，比如我在周五设置在周六18点定时发送邮件。

销香叶雨

呵呵，学习学习……