MS Outlook 2000 Attachment Management

#0
11.07.2002, 19:34
Administrator
Avatar Lukas

Beiträge: 1742
#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 :yo
Dieser Beitrag wurde am 13.07.2002 um 22:50 Uhr von Lukas editiert.
Seitenanfang Seitenende
11.07.2002, 19:48
Ehrenmitglied
Avatar Robert

Beiträge: 2283
#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, ...
Seitenanfang Seitenende
Um auf dieses Thema zu ANTWORTEN
bitte erst » hier kostenlos registrieren!!

Folgende Themen könnten Dich auch interessieren: