Good to Know Database

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


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 ]


Valid XHTML 1.0 Transitional Valid CSS Valid Atom 1.0

© 2004-2018 by Georg Kainzbauer