Microsoft Office. Outlook Add-in und Add-on Software.

 

 

 

 

 VBA; Programmierung mit Outlook - Events

Ereignisse abfangen

Im Modul "DieseOutlookSitzung" können Ereignisse abgefangen werden, zum Beispiel das eintreffen einer neuen E-Mail.

 

Automatisch auf eintreffende E-Mails reagieren

Wie können dazu sehr viele schöne Dinge mit neuen E-Mails machen, zum Beispiel die E-Mails oder Anhänge ausdrucken, uns die E-Mails vorlesen lassen oder die E-Mails automatisch verarbeiten, zum Beispiel wenn ein Webformular ausgefüllt wurde automatisch einen Kontakt anlegen.

 

Die Grundfunktion ist folgende:

 

shared Function GetWord(ByRef s As String) As String
  Dim p As Integer
  p = InStr(1, s, ",")
  If p = 0 Then
     GetWord = s
     s = ""
   Else
      GetWord = Left(s, p - 1)
      s = Mid(s, p + 1)
    End If
End Function

 

Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
   Dim mai As Object
  Dim eid As String
  On Error Resume Next
  Do
    eid = GetWord(EntryIDCollection)
    If eid = "" Then Exit Do
    Set mai = Application.session.GetItemFromID(eid)
    DoSomethingWithMail mai
  Loop
End Sub

 

GetWords ist eine Hilfsfunktion, welche mit Komma separierte Zeichenketten aufsplittet, bei jedem Aufruf kommt das nächste "Wort"

 

In Application_NewMailEx erhalten wir eine Kommaseparierte Liste von EntryIDs der neuen E-Mails, normalerweise ist dies nur eine einzige, bei Exchange können es aber schon einmal mehrere sein. Wir gehen jetzt in einer Schleife durch die E-Mails durch und öffnen jede einzelne, danach wird DoSomething (MachIrgendwas) mit jeder E-Mail aufgerufen.

 

Statt DoSomething können wir uns sinnvolle Dinge ausdenken:

  1. Bestimmte eintreffende E-Mails ausdrucken
  2. Die E-Mails (oder den Betreff) vorlesen lassen
  3. Die Anhänge abspeichern
  4. Falls eine E-Mail mit einer VCard eintrift, die VCard automatisch in den Kontakten anlegen.
  5. Falls ein Webform mit Kontaktdaten eintrift, einen Kontakt anlegen
  6. E-Mails automatisch beantworten, zum Beispiel bei Abwesenheit.
  7. usw.

Eintreffende E-Mails ausdrucken

Um die E-Mails auszudrucken, kann folgende Funktion verwendet werden:

 

' Ausdruck aller Anhänge einer E-Mail

Private Sub PrintMail(mai As Object)
  Dim p As String
  Dim path As String
  Dim ext As String
  Dim f As String
  Dim l As Integer
  Dim printit As Boolean
  Dim att As Attachment

  p = Space$(256)
  l = GetTempPath(255, p)
  path = Left(p, l)

  For Each att In mai.Attachments
        l = InStr(att.FileName, ".")
        If l <> 0 Then ext = LCase(Mid(att.FileName, l + 1)) Else ext = ""

       ' nachprüfen ob wir drucken wollen
        printit = False
        If ext = "pdf" Then printit = True
        If ext = "doc" Then printit = True
        If ext = "xls" Then printit = True

        If printit Then
             f = path + att.FileName
             att.SaveAsFile f
             ShellExecute 0, "print", f, "", "", SW_SHOW
        End If
   Next att
End Sub

 

sub DoSomethingWithEmail(mai as object)

    PrintIt mai

end sub


Die Funktion sollte noch erweitert werden um zum Beispiel den Betreff oder den Absender zu prüfen, so dass zum Beispiel nur E-Mails aus Faxmails und Bestellungen automatisch gedruckt werden.

 

Schreiben Sie dazu zum Beispiel:

 

Private Sub PrintMail(mai As Object)
  Dim p As String
  Dim path As String
  Dim ext As String
  Dim f As String
  Dim l As Integer
  Dim printit As Boolean
  Dim att As Attachment

  p = Space$(256)
  l = GetTempPath(255, p)
  path = Left(p, l)

  For Each att In mai.Attachments

        if mai.SenderEmailAddress = "faxmail@faxprovider.de" then
             f = path + att.FileName
             att.SaveAsFile f
             ShellExecute 0, "print", f, "", "", SW_SHOW
        End If
   Next att
End Sub

 

Wenn sie mai als MailItem definieren ist das Programmieren einfacher, weil Outlook nach der Eingabe des Punktes alle möglichen Felder des Objektes vorschlägt. Im Betrieb sollte es object sein, weil eine eigehende E-Mail nicht immer ein MailItem ist, was dann im Script einen Fehler produzieren würde.

 

Anhänge abspeichern

 

shared Function SaveMail(basedir As String, item As Object)
  Dim attach As Attachment
  Dim fname As String
  If item.Attachments.count > 0 Then
    '  Verzeichnisname = Absendername
    ' Alternativ kann man auch item.subject verwenden oder Datum oder alles Zusammenbauen
     fname = basedir & MakeFname(item.SenderName)
     On Error Resume Next
     ' Dies weglassen wenn man nur VCARDS will
      MkDir fname
     On Error GoTo 0
     For Each attach In item.Attachments
          fname = basedir & "vcards\" & MakeFname(attach.filename)
          attach.SaveAsFile fname
          ReadDefaultFolderVCard fname, item.SenderEmailAddress
          End If
     Next attach
  End If
End Function