Hallo,

gerne möchte ich die Bezeichnung des Anhangs im Outlook als Betreff erhalten. Jetzt habe ich schon einige Codes ausprobiert. Seht ihr eine Fehler?


Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
Dim objMail As MailItem
Dim objAtt As Attachment
Dim strSubject As String
Dim strNewSubject As String
Dim Antwort As VbMsgBoxResult

' Nur fortfahren, wenn es sich um eine Mail handelt
If TypeName(Item) = "MailItem" Then
Set objMail = Item

' Wenn keine Anhänge vorhanden sind, kein Dialog notwendig
If objMail.Attachments.Count = 0 Then Exit Sub

' Benutzer fragen
Antwort = MsgBox("Anhänge automatisch im Betreff ergänzen?", vbYesNo + vbQuestion, "Betreff-Anpassung")

If Antwort = vbYes Then
strSubject = objMail.Subject
strNewSubject = strSubject

For Each objAtt In objMail.Attachments
If InStr(1, strNewSubject, objAtt.FileName, vbTextCompare) = 0 Then
If strNewSubject = "" Then
strNewSubject = objAtt.FileName
Else
strNewSubject = strNewSubject & " - " & objAtt.FileName
End If
End If
Next objAtt

' Nur setzen, wenn sich etwas geändert hat
If strNewSubject > strSubject Then
objMail.Subject = strNewSubject
End If
End If
End If

' Aufräumen
Set objAtt = Nothing
Set objMail = Nothing
End Sub