MS Outlook 2000 Attachment Management

#1 Hi Outlookianer!

Ich durfte gerade das Emailsystem einer kleinen Company optimieren, und bin dabei über folgenden Tipp / VB für Microsoft Outlook gestolpert, der Outlook um folgendes Feature erweitert:

Überprüft alle ungelesenen Mails auf Attachments, speichert diese
auf Wunsch als Datei und entfernt sie anschließend aus der Mail.

'Füge den Inhalt dieser Textdatei im VB-Editor (Alt-F11) ins vorhandene Klassenmodul '"DieseOutlookSitzung" (unterhalb von "Microsoft Outlook Objekte") ein.

Code

Private Sub Application_NewMail()
    'Überprüft alle ungelesenen Mails auf Attachments, speichert diese
    'auf Wunsch als Datei und entfernt sie anschließend aus der Mail.

    Dim objNameSpace As NameSpace
    Dim objPosteingang As MAPIFolder
    Dim objNachricht As MailItem
    Dim strMsg As String
    Dim intI As Integer
    Dim intButton As String
    Dim strBasisOrdner As String
    Dim strOrdner As String
    Dim strPfadname As String

    strBasisOrdner = "c:"
    If Right(strBasisOrdner, 1) <> "" Then
        strBasisOrdner = strBasisOrdner & ""
    End If

    Set objNameSpace = Application.GetNamespace("MAPI")
    Set objPosteingang = objNameSpace.GetDefaultFolder(olFolderInbox)
    For Each objNachricht In objPosteingang.Items
        If objNachricht.UnRead = True And objNachricht.Attachments.Count > 0 Then
            strMsg = "Die Nachricht " & Chr(34) & objNachricht.Subject & Chr(34) & " von " & objNachricht.SenderName & " enthält folgende Anhänge:" & vbCr
            For intI = 1 To objNachricht.Attachments.Count
                strMsg = strMsg & "- " & objNachricht.Attachments(intI).FileName & vbCr
            Next
            strMsg = strMsg & vbCr & "Möchtest Du diese Anhänge separat speichern und aus der Nachricht entfernen?"

            intButton = MsgBox(strMsg, vbYesNoCancel + vbQuestion, "Anhang separieren")
            If intButton = vbCancel Then
                Exit For
            ElseIf intButton = vbYes Then
                strOrdner = strBasisOrdner & Date
                If Dir(strOrdner & "\nul") = "" Then
                    MkDir strOrdner
                End If

                objNachricht.Display
                For intI = objNachricht.Attachments.Count To 1 Step -1
                    strPfadname = strOrdner & "" & objNachricht.Attachments(intI).FileName
                    objNachricht.Attachments(intI).SaveAsFile strPfadname
                    objNachricht.Body = objNachricht.Body & vbCr & "<<" & objNachricht.Attachments(intI).FileName & ">> separiert nach: " & strOrdner
                    objNachricht.Attachments(intI).Delete
                Next

                objNachricht.Close olSave
            End If
        End If
    Next
End Sub

Wäre interessant, ob das auch unter Outlook XP klappt!???

Viel Spaß
Lukas
__________
Gruß Lukas

#2 Das ganze gibt es auch sehr komfortabel als kleines Programm und für beliebige Ordner: http://www.rsbr.de/Software/OASniffer/index_eng.htm

Robert
__________
powered by http://different-thinking.de - Netze, Protokolle, Sicherheit, ...