Gem alle vedhæftede filer i din Indbakke

by Andreas Andersen · Published 16. juli 2022 · Updated 16. juli 2022

I denne artikel vil jeg sætte fokus på muligheder for at du kan gemme alle vedhæftede filer for en hel e-mailadresse / indbakke på én gang.

Det kan være praktisk at kunne trække alle vedhæftede filer ud, der er sendt med alle dine mails i din indbakke. Det har man for eksempel brug for, hvis man gerne vil gemme filerne som backup. Det er desværre ikke noget man sådan uden videre kan gøre direkte i dit mailprogram, men i denne artikel vil jeg sætte fokus på forskellige muligheder.

Brug Thunderbird

Ofte når jeg har brug for at få løst problemer med e-mails bruger jeg Thunderbird. Thunderbird er et gratis avanceret mailprogram ligesom Microsoft Outlook, som er udgivet som open source, ligesom for eksempel Firefox er en alternativ open source browser.

Hvis du tilknytter din e-mailadresse til Thunderbird, så har du her muligheder for at bruge forskellige værktøjer til at trække de vedhæftede filer ud. Jeg har prøvet at bruge udvidelsen ImportExportTool NG, som du nemt kan installere i Thunderbird. Så har du muligheden for at højreklikke på en mappe, vælge ImportExportTool NG, så Eksporter alle meddelser i mappen og så vælger du “HTML-format (med vedhæftede filer)”. Så vil filerne blive eksporteret som undermapper sammen med HTML filer for alle dine e-mails.

En udfordring kan dog være hvis de e-mails du gerne vil tage en backup af er sendt med Microsoft Outlook eller Microsoft Exchange. Her risikerer du at de vedhæftede filer konverteres til Winmail.dat filer, og du derfor hverken kan se eller åbne dem. Her kan du så installere den udvidelse der hedder LookOut, som forsøger at konvertere dem tilbage igen.

Brug en makro i Microsoft Outlook

En alternativ løsning direkte i Microsoft Outlook er at bruge en makro. Her har Lorin Segev udviklet en makro som jeg selv har tilpasset til mine behov nedenunder. På hans hjemmeside kan du direkte downloade en BAS-fil som indeholder koden til makroen, som du så kan installere. I nedenstående kode har jeg ændret den lidt, bl.a. så der sættes dato på hver vedhæftet fil.

Option Explicit


Sub GetAttachments()
On Error Resume Next

    Dim fso, ttxtfile, txtfile, WheretosaveFolder
    Dim objFolders As Object
    Set objFolders = CreateObject("WScript.Shell").SpecialFolders
 
    ttxtfile = objFolders("mydocuments")
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set txtfile = fso.CreateFolder(ttxtfile & "\Emailfiler")

    WheretosaveFolder = ttxtfile & "\Emailfiler"
    
On Error GoTo GetAttachments_err

    Dim ns As NameSpace
    Dim Inbox As MAPIFolder
    Dim Item As Object
    Dim Atmt As Attachment
    Dim FileName As String
    Dim i As Integer
    Set ns = GetNamespace("MAPI")

    Set Inbox = ns.PickFolder
    
    If Inbox Is Nothing Then
                MsgBox "You need to select a folder in order to save the attachments", vbCritical, _
               "Export - Not Found"
        Exit Sub
    End If

    i = 0

    If Inbox.Items.Count = 0 Then
        MsgBox "Der er ingen e-mails i den pågældende mappe", vbInformation, _
               "Ingen vedhæftede filer"
        Exit Sub
    End If

    For Each Item In Inbox.Items

        For Each Atmt In Item.Attachments

            FileName = WheretosaveFolder & "\" & Format(Item.ReceivedTime, "yyyymmdd") & " - " & fso.GetBaseName(Atmt.FileName) & i & "." & fso.GetExtensionName(Atmt.FileName)

            Atmt.SaveAsFile FileName
            i = i + 1
         Next Atmt
    Next Item

    If i > 0 Then
        MsgBox "Der blev fundet " & i & " vedhæftede filer." _
        & vbCrLf & "De er alle gemt i mappen Emailfiler i din dokumentmappe", vbInformation, "Vedhæftede filer gemt"
    Else
        MsgBox "Der var ingen vedhæftede filer i de pågældende mails", vbInformation, "Ingen vedhæftede filer fundet"
    End If

        Set fso = Nothing


GetAttachments_exit:
    Set Atmt = Nothing
    Set Item = Nothing
    Set ns = Nothing
    Exit Sub

GetAttachments_err:
    MsgBox "Der er sket en fejl" _
        & vbCrLf & "Følgende fejl er sket:" _
        & vbCrLf & "Macro Name: GetAttachments" _
        & vbCrLf & "Error Number: " & Err.Number _
        & vbCrLf & "Error Description: " & Err.Description _
        , vbCritical, "Error!"
    Resume Next
End Sub

For at få den til at virke, skal du have vist Udvikler-fanen i Outlook. Det gør du ved at åbne instillinger, så vælge “Tilpas båndet” og så sætte kryds ved Udvikler-fanen.

Så dukker Udvikler-fanen op øverst. Her vælger du så “Visual Basic” for at åbne kodevinduet:

I vinduet højreklikker du på mappen “Modules” og vælger så “Insert” og så “Module”. Her copy-paster du bare ovenstående kode ind og trykker på Gem.

Så kører du koden direkte ved at vælge “Makroer” på Udviker-fanen og så den øverste fil. Der spørges efter hvilken e-mailmappe du vil tage backup fra og så gemmes de i din dokument-mappe i undermappen “EmailAttachments”.