Oder so mit Abfrage, um einen Dateinamen zu vergeben:

Public Sub SaveAttachments()

Dim coll As VBA.Collection
Dim obj As Object
Dim Att As Outlook.Attachment
Dim Sel As Outlook.Selection
Dim Path$
Dim i&
Dim Dateiname As String

Path = "C:\Users\DB\.1 L1\PL\"
Set coll = New VBA.Collection

If TypeOf Application.ActiveWindow Is Outlook.Inspector Then
    coll.Add Application.ActiveInspector.CurrentItem
Else
    Set Sel = Application.ActiveExplorer.Selection
    For i = 1 To Sel.Count
        coll.Add Sel(i)
    Next
End If

For Each obj In coll
    For Each Att In obj.Attachments
        Dateiname = InputBox("Bitte Dateinamen vergeben", "Anhang speichern als")
        Att.SaveAsFile Path & Dateiname
    Next
Next

End Sub

Gruss Torsten