Thema Datum  Von Nutzer Rating
Antwort
Rot Outlook VBA Anhänge speichern
20.09.2024 11:17:06 Dennis
Solved
20.09.2024 11:39:59 Gast7188
NotSolved
20.09.2024 11:52:22 Gast17083
NotSolved
20.09.2024 12:41:31 Dennis
NotSolved
20.09.2024 13:04:57 Gast36179
NotSolved
20.09.2024 13:52:27 Gast86273
NotSolved
20.09.2024 14:23:44 Dennis
NotSolved
20.09.2024 14:54:51 ralf_b
NotSolved
23.09.2024 10:32:00 Dennis
NotSolved
23.09.2024 17:46:42 Gast6083
NotSolved

Ansicht des Beitrags:
Von:
Dennis
Datum:
20.09.2024 11:17:06
Views:
162
Rating: Antwort:
 Nein
Thema:
Outlook VBA Anhänge speichern

Hallo,

ich bräuchte bitte Hilfe, da ich wenig bis keine Ahnung von Outlook VBA habe.

In der Masse an Beiträgen im Netz habe ich kein für meine Zwecke funktionierendes VBA Skript für Outlook gefunden. Leider kann ich die vermutlich wenigen Anpassungen nicht selbst vornehmen.

Das Skript speichert die Anhänge von markierten E-Mails in einem ausgewählten Ordner. Für jede E-Mail wird ein Unterordner mit dem Betreff der E-Mail erstellt, in dem die Anhänge gespeichert werden.

 

Sub SaveAttachmentsFromSelectedEmails()
    Dim objSelection As Selection
    Dim objItem As Object
    Dim objMail As MailItem
    Dim objAttachment As Attachment
    Dim strFolderPath As String
    Dim strSubFolderPath As String
    Dim objFSO As Object
    Dim objSubFolder As Object
    Dim strFileName As String
    Dim strSubject As String
    Dim i As Integer

    ' Auswahl der markierten E-Mails
    Set objSelection = Application.ActiveExplorer.Selection
    
    ' Wenn keine E-Mail ausgewählt ist
    If objSelection.Count = 0 Then
        MsgBox "Bitte wähle eine oder mehrere E-Mails aus.", vbExclamation
        Exit Sub
    End If
    
    ' Benutzer wählt den Ordner, in den die Anhänge gespeichert werden
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Wähle den Ordner, in dem die Anhänge gespeichert werden sollen"
        If .Show <> -1 Then Exit Sub
        strFolderPath = .SelectedItems(1)
    End With
    
    ' FileSystemObject für die Ordnerverwaltung
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    
    ' Schleife durch alle ausgewählten E-Mails
    For Each objItem In objSelection
        ' Prüfen, ob es sich um eine E-Mail handelt
        If TypeOf objItem Is MailItem Then
            Set objMail = objItem
            
            ' Betreff der E-Mail als Unterordnername (nicht erlaubte Zeichen ersetzen)
            strSubject = objMail.Subject
            strSubject = Replace(strSubject, ":", "")
            strSubject = Replace(strSubject, "\", "")
            strSubject = Replace(strSubject, "/", "")
            strSubject = Replace(strSubject, "?", "")
            strSubject = Replace(strSubject, "*", "")
            strSubject = Replace(strSubject, "<", "")
            strSubject = Replace(strSubject, ">", "")
            strSubject = Replace(strSubject, "|", "")
            strSubject = Replace(strSubject, """", "")
            
            ' Pfad für den Unterordner
            strSubFolderPath = strFolderPath & "\" & strSubject
            
            ' Erstelle den Unterordner, falls er nicht existiert
            If Not objFSO.FolderExists(strSubFolderPath) Then
                objFSO.CreateFolder strSubFolderPath
            End If
            
            ' Speichern der Anhänge
            If objMail.Attachments.Count > 0 Then
                For i = 1 To objMail.Attachments.Count
                    Set objAttachment = objMail.Attachments(i)
                    
                    ' Dateiname des Anhangs
                    strFileName = objAttachment.FileName
                    
                    ' Speichern des Anhangs im Unterordner
                    objAttachment.SaveAsFile strSubFolderPath & "\" & strFileName
                Next i
            End If
        End If
    Next objItem
    
    MsgBox "Anhänge wurden erfolgreich gespeichert.", vbInformation
End Sub

 

Ich bekomme eine Fehlermeldung, dass die Dialogbox für die Ordnerauswahl nicht unterstützt wird.

Folgende Eigenschaften benötige ich:

1. Auswahl der markierten E-Mails: Das Skript greift auf die markierten E-Mails in Outlook zu.

2. Ordnerauswahl: Es wird ein Dateiauswahl-Dialog angezeigt, um den Zielordner zu wählen, in dem die Anhänge gespeichert werden.

3. Erstellung eines Unterordners für jede E-Mail: Ein Unterordner wird für jede E-Mail erstellt, wobei der Betreff der E-Mail als Name des Unterordners dient.

4. Speichern der Anhänge: Alle Anhänge der E-Mail werden im entsprechenden Unterordner gespeichert.

Vielen Dank vorab!!!

 


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
Rot Outlook VBA Anhänge speichern
20.09.2024 11:17:06 Dennis
Solved
20.09.2024 11:39:59 Gast7188
NotSolved
20.09.2024 11:52:22 Gast17083
NotSolved
20.09.2024 12:41:31 Dennis
NotSolved
20.09.2024 13:04:57 Gast36179
NotSolved
20.09.2024 13:52:27 Gast86273
NotSolved
20.09.2024 14:23:44 Dennis
NotSolved
20.09.2024 14:54:51 ralf_b
NotSolved
23.09.2024 10:32:00 Dennis
NotSolved
23.09.2024 17:46:42 Gast6083
NotSolved