Guten Abend VBA Spezialisten
Ich habe keine Frage zu Excel sondern zu Outlook aber grundsätzlich ist es ein VBA Problem
Nachfolgender Code speichert den Anhang oder die Anhänge der markierten Mail im Ordner C:\Mailtest\.
Kann jemand mir helfen den Code abzuändern dass vor dem Speichern ein Dialogfeld erscheint in welchem der Benutzer eine Zahl zB. 1234 eingeben kann welche mit einem Underline vor den Originalnamen gesetzt wird. Also Anhang.pdf sollte letztendlich als 1234_ Anhang.pdf gespeichert sein
Wäre toll wenn jemand helfen würde.
Nachfolgend der Code:
Public Sub SaveAttachments()

Dim objOL As Outlook.Application
Dim objMsg As Outlook.MailItem
Dim objAttachments As Outlook.Attachments
Dim objSelection As Outlook.Selection
Dim i As Long
Dim lngCount As Long
Dim strFile As String
Dim strFolderpath As String

' Outlook Application Objekt instanziieren
Set objOL = CreateObject("Outlook.Application")

' Collection der ausgewählten Objekte (E-Mails) ermitteln
Set objSelection = objOL.ActiveExplorer.Selection

' Ordner-Pfad festlegen, wo der E-Mail Anhang gespeichert werden soll
strFolderpath = "C:\Testmail\"

' Jedes ausgewählten Objekte (E-Mails) prüfen, ob es einen Anhang hat. Wenn Anhang vorhanden,
' dann unter dem Ordnerpfad speichern.
For Each objMsg In objSelection

' Die Anhänge des ausgewählten Objekts (E-Mail) ermitteln
Set objAttachments = objMsg.Attachments
lngCount = objAttachments.Count

If lngCount > 0 Then

' Wir verwenden hier einen rückwärts gerichteten Zähler; umgekehrt sollte es aber auch funktionieren.

For i = lngCount To 1 Step -1

' Save attachment before deleting from item.
' Dateinamen ermitteln
strFile = objAttachments.Item(i).FileName

' Kombiniere Ablagepfad mit dem Dateinamen
strFile = strFolderpath & strFile

' Anhang als Datei speichern
objAttachments.Item(i).SaveAsFile strFile

Next i

End If
Next

ExitSub:
Set objAttachments = Nothing
Set objMsg = Nothing
Set objSelection = Nothing
Set objOL = Nothing
End Sub