Microsoft Outlook 2007: Überprüfungen vor dem Absenden kombinieren
Das folgende Visual Basic Makro ist eine Kombination aus den folgenden Visual Basic Makros und überprüft vor dem Absenden einer Nachricht ob ein Betreff angegeben wurde, ob eventuell ein Anhang vergessen wurde und ob eine vom Benutzer definierte maximale Nachrichtengröße überschritten wurde.
Microsoft Outlook 2007: Vorhandensein des Mail-Betreffs vor dem Absenden prüfen
Microsoft Outlook 2007: Vorhandensein des Anhanges vor dem Absenden prüfen
Microsoft Outlook 2007: Mailgröße vor dem Versenden überprüfen
Öffnen Sie wie bereits auf den drei Seiten beschrieben den Visual Basic Editor und fügen den folgenden Code unter ThisOutlookSession in das Code-Fenster ein. Um das Makro zu signieren lesen Sie bitte Microsoft Outlook 2007: Visual Basic Makro signieren.
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
If Item.Class = olMail Then
If CheckSubject(Item) Then
Cancel = True
Else
If CheckAttachment(Item) Then
Cancel = True
Else
Cancel = CheckMailSize(Item)
End If
End If
End If
End Sub
Private Function CheckSubject(oMail As Outlook.MailItem) As Boolean
Dim Result As Boolean
Dim strMsg As String
Result = False
If oMail.Subject = "" Then
strMsg = "Ihre Nachricht hat keinen Betreff." & vbCrLf & "Nachricht ohne Betreff versenden?"
'strMsg = "Your message has no subject." & vbCrLf & "Send message without subject?"
Result = (MsgBox(strMsg, vbYesNo + vbQuestion, "Kein Betreff") = vbNo)
'Result = (MsgBox(strMsg, vbYesNo + vbQuestion, "No subject") = vbNo)
End If
CheckSubject = Result
End Function
Private Function CheckAttachment(oMail As Outlook.MailItem) As Boolean
Dim Result As Boolean
Dim HasAttachments As Boolean
Dim strMsg As String
Result = False
If NeedsAttachment(oMail.Body) Then
HasAttachments = True
If TypeName(oMail.Attachments) = "Nothing" Then
HasAttachments = False
End If
If oMail.Attachments.Count = 0 Then
HasAttachments = False
End If
If Not HasAttachments Then
strMsg = "Ihre Nachricht hat keinen Anhang." & vbCrLf & "Nachricht ohne Anhang versenden?"
'strMsg = "Your message has no attachment." & vbCrLf & "Send message without attachment?"
Result = (MsgBox(strMsg, vbYesNo + vbQuestion, "Kein Anhang") = vbNo)
'Result = (MsgBox(strMsg, vbYesNo + vbQuestion, "No attachment") = vbNo)
End If
End If
CheckAttachment = Result
End Function
Private Function NeedsAttachment(ByVal text As String) As Boolean
Dim Phrases As Variant
Dim MailBody As String
Dim Result As Boolean
Dim i As Integer, j As Integer
Phrases = Array("anhang", "anlage", "anhängend", "angehängt", "angefügt", _
"beigefügt", "anbei", "attached", "attachment")
MailBody = LCase(text)
Result = False
j = UBound(Phrases)
For i = 0 To j
If InStr(MailBody, Phrases(i)) <> 0 Then
Result = True
Exit For
End If
Next
NeedsAttachment = Result
End Function
Private Function CheckMailSize(oMail As Outlook.MailItem) As Boolean
Dim Result As Boolean
Dim MailSize As Long
Const MaxMailSize As Long = 1048576 ' Maximum message size: 1 MB
Dim strMsg As String
Result = False
If oMail.Attachments.Count Then
oMail.Save
MailSize = oMail.Size
If MailSize > MaxMailSize Then
strMsg = "Ihre Nachricht hat " & MailSize & " Bytes." & vbCrLf & "Senden der Nachricht abbrechen?"
'strMsg = "Your message has " & MailSize & " bytes." & vbCrLf & "Abort sending of the message?"
Result = (MsgBox(strMsg, vbYesNo + vbQuestion, "Maximale Nachrichtengröße überschritten") = vbYes)
'Result = (MsgBox(strMsg, vbYesNo + vbQuestion, "Message size exceeded") = vbYes)
End If
End If
CheckMailSize = Result
End Function
If Item.Class = olMail Then
If CheckSubject(Item) Then
Cancel = True
Else
If CheckAttachment(Item) Then
Cancel = True
Else
Cancel = CheckMailSize(Item)
End If
End If
End If
End Sub
Private Function CheckSubject(oMail As Outlook.MailItem) As Boolean
Dim Result As Boolean
Dim strMsg As String
Result = False
If oMail.Subject = "" Then
strMsg = "Ihre Nachricht hat keinen Betreff." & vbCrLf & "Nachricht ohne Betreff versenden?"
'strMsg = "Your message has no subject." & vbCrLf & "Send message without subject?"
Result = (MsgBox(strMsg, vbYesNo + vbQuestion, "Kein Betreff") = vbNo)
'Result = (MsgBox(strMsg, vbYesNo + vbQuestion, "No subject") = vbNo)
End If
CheckSubject = Result
End Function
Private Function CheckAttachment(oMail As Outlook.MailItem) As Boolean
Dim Result As Boolean
Dim HasAttachments As Boolean
Dim strMsg As String
Result = False
If NeedsAttachment(oMail.Body) Then
HasAttachments = True
If TypeName(oMail.Attachments) = "Nothing" Then
HasAttachments = False
End If
If oMail.Attachments.Count = 0 Then
HasAttachments = False
End If
If Not HasAttachments Then
strMsg = "Ihre Nachricht hat keinen Anhang." & vbCrLf & "Nachricht ohne Anhang versenden?"
'strMsg = "Your message has no attachment." & vbCrLf & "Send message without attachment?"
Result = (MsgBox(strMsg, vbYesNo + vbQuestion, "Kein Anhang") = vbNo)
'Result = (MsgBox(strMsg, vbYesNo + vbQuestion, "No attachment") = vbNo)
End If
End If
CheckAttachment = Result
End Function
Private Function NeedsAttachment(ByVal text As String) As Boolean
Dim Phrases As Variant
Dim MailBody As String
Dim Result As Boolean
Dim i As Integer, j As Integer
Phrases = Array("anhang", "anlage", "anhängend", "angehängt", "angefügt", _
"beigefügt", "anbei", "attached", "attachment")
MailBody = LCase(text)
Result = False
j = UBound(Phrases)
For i = 0 To j
If InStr(MailBody, Phrases(i)) <> 0 Then
Result = True
Exit For
End If
Next
NeedsAttachment = Result
End Function
Private Function CheckMailSize(oMail As Outlook.MailItem) As Boolean
Dim Result As Boolean
Dim MailSize As Long
Const MaxMailSize As Long = 1048576 ' Maximum message size: 1 MB
Dim strMsg As String
Result = False
If oMail.Attachments.Count Then
oMail.Save
MailSize = oMail.Size
If MailSize > MaxMailSize Then
strMsg = "Ihre Nachricht hat " & MailSize & " Bytes." & vbCrLf & "Senden der Nachricht abbrechen?"
'strMsg = "Your message has " & MailSize & " bytes." & vbCrLf & "Abort sending of the message?"
Result = (MsgBox(strMsg, vbYesNo + vbQuestion, "Maximale Nachrichtengröße überschritten") = vbYes)
'Result = (MsgBox(strMsg, vbYesNo + vbQuestion, "Message size exceeded") = vbYes)
End If
End If
CheckMailSize = Result
End Function
Dieser Eintrag wurde am 21.05.2012 erstellt und zuletzt am 24.01.2016 bearbeitet.
Direkter Link zu dieser Seite: http://www.gtkdb.de/index_21_1626.html
[ Zur Startseite ] [ Zur Kategorie ]
© 2004-2021 by Georg Kainzbauer