VBA: Outlook-E-Mails mit "Speichern unter" speichern u.a.

Moderator: ModerationP

VBA: Outlook-E-Mails mit "Speichern unter" speichern u.a.

Beitragvon Berghüttenwart » 17. Apr 2019, 15:10

Hallo liebe Experten,

ich habe einen VBA-Code zusammengestellt (zum größten Teil von anderen kopiert), der E-Mails mit einem Zeitstempel im Betreff abspeichert.

Nun möchte ich das Ganze noch weiter optimieren:

1. Es soll eine Speicherortauswahl wie im gewohnten "Speichern unter"-Fenster möglich sein (an der Stelle, wo jetzt "Pfad = InputBox("Wo möchten Sie diese Mail(s) speichern?", "E-Mail-Speicherung", "E:\")" steht). Momentan muss ich den Pfad entweder reinschreiben oder reinkopieren.
2. Außerdem sollen aus dem Betreff die Kürzel wie "AW:", "Fw:" oder "WG:" gefiltert werden, um die 10 Zeichen sinnvoller zu nutzen.
3. Der aktuelle Code ermöglicht keine Speicherung von Besprechungseinladungen und -zusagen/-ablehnungen. Wenn dies noch möglich wäre, dann wäre der Code nach jetzigen Ansprüchen nahezu perfekt.

Könnte mir da jemand helfen?

Der aktuelle Code sieht so aus:

-----------------------------------------------------------------------------------
Private Lfn As Integer
Private Pfad As String

Sub Markierte_Mails_Speichern()
'hier den gewünschten Pfad zum Speichern festlegen

'PfadOrdner = Application.ActiveExplorer.Selection(1).Subject
Pfad = InputBox("Wo möchten Sie diese Mail(s) speichern?", "E-Mail-Speicherung", "E:\")

On Error GoTo Fehler
' Variablen
Dim Ordner As MAPIFolder
Dim SelektierteMail As MailItem
Dim Selektion As Selection
Dim Anzahl_kopierte_Mails As Integer

'Objekte zuweisen
Set Ordner = Application.ActiveExplorer.CurrentFolder
Set Selektion = Application.ActiveExplorer.Selection
Anzahl_kopierte_Mails = 0

If Selektion.Count = 0 Then
MsgBox "Bitte Mails auswählen!"
Else
For Each SelektierteMail In Selektion
Mail_Speichern SelektierteMail
Anzahl_kopierte_Mails = Anzahl_kopierte_Mails + 1
Next
End If
MsgBox "Kopiervorgang beendet, " & Anzahl_kopierte_Mails & " Mail(s) kopiert"
Exit Sub
Fehler:
MsgBox Err.Description + " Bitte sicherstellen, dass im gewählten Ordner Mails markiert sind und der Ordner ein Mailordner ist!"
End Sub


Private Sub Mail_Speichern(ByVal Mail As Object)

Dim Betreff As String
Dim Absender As String
Dim SaveString As String
Dim AuftragsNr As String
Dim Eingangsdat As String


If TypeName(Mail) = "MailItem" Then
Absender = Mail.SenderName
Betreff = Mail.Subject
Eingangsdat = Format(Mail.ReceivedTime, "YYYY-MM-DD_hh-mm-ss")

'stellt eine 4 stellige Laufnummer voran, damit sich Mails mit gleichem Betreff und Absender nicht doppeln
'die Formation ist zur besseren Sortierung im Explorer, bei mehr als 10000Mails einfach mehr Nullen voranstellen lassen

Betreff = Eingangsdat & "_" & Format$(Lfn, "00") & "_" & Absender & Left(Betreff, 10)

'Folgende Zeilen filtern alle möglichen Sonderzeichen raus, die nicht als Dateinamen auftreten dürfen
Betreff = Replace(Betreff, ":", "-")
Betreff = Replace(Betreff, "*", "#")
Betreff = Replace(Betreff, """", "#")
Betreff = Replace(Betreff, "|", "#")
Betreff = Replace(Betreff, "?", "(Frgzchn)")
Betreff = Replace(Betreff, ">", "-")
Betreff = Replace(Betreff, "<", "-")
Betreff = Replace(Betreff, "/", "-")
Betreff = Replace(Betreff, "\", "-")
Betreff = Replace(Betreff, ", ", "_")
Betreff = Replace(Betreff, ".", "-")
Betreff = Replace(Betreff, "@", "-at-")


'Pfad zusammen stellen
SaveString = Pfad & Betreff & ".msg"

'und Speichern
Mail.SaveAs SaveString, olMSG



End If
Lfn = Lfn + 1
End Sub
------------------------------------------------------------------------------------------
Berghüttenwart
 

Re: VBA: Outlook-E-Mails mit "Speichern unter" speichern u.a

Beitragvon mmarkus » 18. Apr 2019, 11:04

Seit Office 2007 gibt es die FileDialalog Klasse für diesen Zweck.

Hier der Link zur OH mit genauen Infos und Beispielen.

https://docs.microsoft.com/de-de/office ... filedialog

Ansonsten liefert auch Google hunderte Beispiel dazu.
ms access what else
mmarkus
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 1360
Registriert: 16. Apr 2012, 16:07
Wohnort: Oberösterreich


Zurück zu Outlook Forum (provisorisch)

Wer ist online?

Mitglieder in diesem Forum: 0 Mitglieder und 0 Gäste