Thema Datum  Von Nutzer Rating
Antwort
19.03.2018 09:13:10 Sascha
NotSolved
19.03.2018 09:33:00 Gast80361
NotSolved
19.03.2018 09:37:25 Gast72783
NotSolved
Blau Zip-Anhang in Outlook-Entwürfen
19.03.2018 10:51:35 SJ
NotSolved

Ansicht des Beitrags:
Von:
SJ
Datum:
19.03.2018 10:51:35
Views:
545
Rating: Antwort:
  Ja
Thema:
Zip-Anhang in Outlook-Entwürfen

Hallo,

probiere das folgende Makro mal mit Test-Mails aus:

Option Explicit

Public Sub unzipFiles()
    If InStr(1, Application.ActiveExplorer.Caption, "Entwürfe") = 0 Then
        MsgBox "Dieses Makro ist lediglich für den ""Entwürfe""-Ordner vorgesehen.", vbInformation
        Exit Sub
    End If
    
    Dim o As Object
    Dim mail As MailItem
    Dim fso As Object
    Dim fldTmp As Object
    Dim f As Object
    Dim attach As Attachment
    Dim shell As Object
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    If fso.FolderExists(Environ("Temp") & "\unzip") Then
        fso.DeleteFolder Environ("Temp") & "\unzip"
    End If
    
    Set fldTmp = fso.CreateFolder(Environ("Temp") & "\unzip")
    Set shell = CreateObject("Shell.Application")
    
    '//Jede Mail im Ornder durchlaufen
    For Each o In Application.ActiveExplorer.Selection
        '//Wenn das Objekt ein Mailitem ist
        If TypeName(o) = "MailItem" Then
            Set mail = o
            '//Jeden Anhang im unzip Ordner speichern
            For Each attach In mail.Attachments
                attach.SaveAsFile fldTmp.Path & "\" & attach.FileName
                attach.Delete
            Next attach
            '//Jeden Anhang entpacken, wenn dieser eine Zip-Datei ist
            For Each f In fldTmp.Files
                If fso.GetExtensionName(f.Path) = "zip" Then
                    shell.NameSpace(fldTmp.Path).copyhere shell.NameSpace(f.Path).Items
                End If
            Next f
            '//Alle Dateien aus dem unzip Ordner wieder der Mail anhängen
            For Each f In fldTmp.Files
                If Not fso.GetExtensionName(f.Path) = "zip" Then
                    mail.Attachments.Add f.Path
                End If
                f.Delete
            Next f
            mail.Save
        End If
    Next o
    
    Set shell = Nothing
    Set fldTmp = Nothing
    Set mail = Nothing
    Set fso = Nothing
End Sub

Viele Grüße


Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
19.03.2018 09:13:10 Sascha
NotSolved
19.03.2018 09:33:00 Gast80361
NotSolved
19.03.2018 09:37:25 Gast72783
NotSolved
Blau Zip-Anhang in Outlook-Entwürfen
19.03.2018 10:51:35 SJ
NotSolved