Outlook 2003 Makro für Betreff-Veränderung

Hallo Zusammen,

Ich bin auf der Suche nach einem Makro der das Erhalten-Datum und den Namen (am besten nur den Nachnamen) des Absenders (also Von) in den Betreff vor dem eigentlichen Betreff-Thema kopiert.

Bsp. im Falle einer geöffneten email vor der Makro-Anwendung:

Von: Müller, Peter Gesendet: Fr 19.02.2010 15:21

Betreff: Week of 15 March townmeetings

nach der Makro-Anwendung:

Von: Müller, Peter Gesendet: Fr 19.02.2010 15:21

Betreff: 2010-02-19 Müller Week of 15 March townmeetings

Wie man am Bsp. sieht soll die Uhrzeit nicht kopiert werden, das Datum ein bestimmtes Format bekommen und jeweils Leerzeichen zwischen Datum Nachname und Betreffeintrag.

Im Internet konnte ich bisher niemanden finden der genau das gleiche Problem hatte. Was ich fand und meinem Problem etwas näher kommt seht ihr hier unten. Vielen Dank schon mal für eure Hilfe! Ich würd mich über wertvolle Tips oder gar eine Lösung sehr freuen!

Public Sub InsertDate()

'=====================================================================  
' Fügt an den Anfang des Betreffs eines Elements das Datum ein.  
' (c) Peter Marchert - http://www.outlook-stuff.com  
' 2008-11-09 - Version 1.0.0  
' 2008-11-21 - Version 1.0.1  
'=====================================================================  

Dim objItem As Object ' Aktuelles Element  

'---------------------------------------------------------------------  
' Fehlerbehandlung wegen Set-Anweisungen ausschalten  
'---------------------------------------------------------------------  
On Error Resume Next

'---------------------------------------------------------------------  
' Aktuell geöffnetes Element refernzieren  
'---------------------------------------------------------------------  
Set objItem = Outlook.ActiveInspector.CurrentItem

'---------------------------------------------------------------------  
' Wenn kein Element geöffnet ist, dann markiertes verwenden  
'---------------------------------------------------------------------  
If objItem Is Nothing Then Set objItem = Outlook.ActiveExplorer.Selection(1)

'---------------------------------------------------------------------  
' Auch nichts markiert?  
'---------------------------------------------------------------------  
If objItem Is Nothing Then GoTo ExitProc

'---------------------------------------------------------------------  
' Mit dem Formatbefehl wird das Datum maschinell sortierbar  
'---------------------------------------------------------------------  
objItem.Subject = Format(Date, "yyyy-MM-dd") & " " & objItem.Subject  

'---------------------------------------------------------------------  
' Änderung speichern  
'---------------------------------------------------------------------  
objItem.Save

ExitProc:

'---------------------------------------------------------------------  
' Referenz auf Element löschen  
'---------------------------------------------------------------------  
Set objItem = Nothing

End Sub

Bitte markiere auch die Kommentare, die zur Lösung des Beitrags beigetragen haben

Content-ID: 137647

Url: https://administrator.de/contentid/137647

Ausgedruckt am: 23.11.2024 um 12:11 Uhr

4 Kommentare

Neuester Kommentar

Moin TecAttack,

ich hab mal deinen Codeschnipsel in Code-tags gesetzt, damit ich einzelne Zeilennummern ansprechen kann.
Du kannst einfach den fast schon fertigen neuen Betreff-String in Zeile 35 um den Absendernamen erweitern.

...
'---------------------------------------------------------------------
' Mit dem Formatbefehl wird das Datum maschinell sortierbar
'---------------------------------------------------------------------
' [alt] objItem.Subject = Format(Date, "yyyy-MM-dd") & "  " & objItem.Subject
objItem.Subject = Format(Date, "yyyy-MM-dd") & "  [" & objItem.SenderName & "] " & objItem.Subject
....

Anmerkungen:
Dringendst würde ich empfehlen, noch mindestens eine Prüfung mehr auf das "markierte Objekt" zu machen, nämlich ob es sich bei diesem Schlingel denn um eine Mail handelt (und nicht eine Notiz, eine Erinnerung oder einen kontakt in einem öffentlichen Ordner).
Dazu die Prüfung " If objItem.Class <> olMail Then GoTo ExitProc" bzw. "If objItem.Class <> 43 Then GoTo ExitProc" nach der heutigen Zeile 30 einbauen.

Zweite Anmerkung: ich baue den kompletten Absendernamen in den Betreff ein. Also den "Müller, Peter (Hugos Frittenbude)" oder wie immer der volltsändige angezeigte Name lauten mag.
Wenn du den Namen z.B. nur bis zum ersten auftretenden Komma anzeigen willst (e.g. "Müller" oder bis zur ersten Klammer-Auf ("Müller, Peter"), dann musst du selbst ein wenig feintunen.
Denn sowohl Komma als auch "(" = Klammer-Auf können, aber müssen nicht im String enthalten sein.
Ein Rausfieseln der (möglicherweise) Nachnamens als "das, was vor dem ersten Komma steht", könnte so oder ähnlich aussehen:

...
Dim strDispSender as String
Dim i as Long
...
 ' wenn ein Komma im SENDERNAME enthalten ist..  
i = instr(1, objItem.Sendername, ",")  
If ( i > 0) Then
  strDispSender = left( objItem.sendername, i-1)
Else
  strDispSender = objItem.sendername
End if
...
'... und / oder eine ähnliche Mimik für kürzen vor erster "("  

[alles vollkommen ungetestet]

Grüße
Biber

Guten Morgen Biber,

Vorab vielen Dank für all die Tipps, Tricks und Vorschläge!!!!

ich hab mal deinen Codeschnipsel in Code-tags gesetzt, damit ich einzelne Zeilennummern ansprechen kann.

Danke auch hierfür!

Du kannst einfach den fast schon fertigen neuen Betreff-String in Zeile 35 um den Absendernamen erweitern.
...
'---------------------------------------------------------------------
' Mit dem Formatbefehl wird das Datum maschinell sortierbar
'---------------------------------------------------------------------
' [alt] objItem.Subject = Format(Date, "yyyy-MM-dd") & " " & objItem.Subject
objItem.Subject = Format(Date, "yyyy-MM-dd") & " [" & objItem.SenderName & "] " &
objItem.Subject

Hab es fast genauso erweitert wie hier oben vorgeschlagen, d.h. hab nur "[" und "]" weggelassen. Danke für den Vorschlag! Ging auch!

Hab die hier oben zusätzliche Prüfung hoffentlich richtig eingesetzt. Hab das Makro an einem Outlooktermin in meinem Posteingang ausprobiert und es tut sich nichts. Unten ist der überarbeitete Code zu sehen.

Zweite Anmerkung: ich baue den kompletten Absendernamen in den Betreff ein. Also den "Müller, Peter (Hugos
Frittenbude)" oder wie immer der volltsändige angezeigte Name lauten mag.
Wenn du den Namen z.B. nur bis zum ersten auftretenden Komma anzeigen willst (e.g. "Müller" oder bis zur ersten
Klammer-Auf ("Müller, Peter"), dann musst du selbst ein wenig feintunen.
Denn sowohl Komma als auch "(" = Klammer-Auf können, aber müssen nicht im String enthalten sein.
Ein Rausfieseln der (möglicherweise) Nachnamens als "das, was vor dem ersten Komma steht", könnte so oder
ähnlich aussehen:

Dim strDispSender as String
Dim i as Long
...
' wenn ein Komma im SENDERNAME enthalten ist..
i = instr(1, objItem.Sendername, ",")
If ( i > 0) Then
strDispSender = left( objItem.sendername, i-1)
Else
strDispSender = objItem.sendername
End if
...
'... und / oder eine ähnliche Mimik für kürzen vor erster "("

Hab ich wie hier oben vorgeschlagen übernommen und auch ein wenig (für mich logische) abgeänderte Versionen ausprobiert. Aber irgendwie hab ich es nicht hinbekommen nur den Nachnamen darstellen zu lassen, es erscheint "Müller, Peter" im Betreff. Vielleicht kannst du mir da noch einen Tipp geben?

Bzgl. des Datums: Also im Code steht ja bloß "Date" und genaugenommen ist es offensichtlich das aktuelle Datum. Dieses Makro wird der Ablage für fast ausschließlich ältere emails dienen, d.h. irgendwan nach dem ich eine email erhalten habe werde ich individuell entscheiden ob ich eine email aus bestimmten Gründen ablegen muss. Weiterhin kann ich deshalb das Makro nicht über eine Regel in Outlook ausführen lassen, so dass z.B. emails bei Eingang automatisch verändert werden und somit auch das Eingangsdatum enthalten (wenn ich auf die email antworten würde müsste ich die Änderungen im Betreff rückgängig machen) (war bloß so ne Überlegung). Es wäre super wenn ich das Erhalten- bzw. Gesendet-Datum im Betreff hätte, statt dem aktuellem Datum. Ich hab auch schon rumprobiert und "Date" durch viele diverse Wortspiele wie "SendDate", "DateReceived", usw. ersetzt aber leider hat nichts davon funktioniert. Vielleicht kannst du mir auch hier einen ordentlichen Schubs Richtung Lösung geben?

Sehr wahrscheinlich hast du längst bemerkt, dass ich das Gegenteil eines VBA-Profis bin. Solange ich noch keine Zeit habe VBA intensiv zu lernen (enrsthaft, keine Ausrede) weiß ich jede Hilfe zu schätzen und hoffentlich lerne ich auf diese Weise so viel wie möglich.

Gruß
TecAttack

Hier der überarbeitete Code:

Public Sub InsertDateAndSenderName()

'=====================================================================  
' Fügt an den Anfang des Betreffs eines Elements das Datum ein.  
' (c) Peter Marchert - http://www.outlook-stuff.com  
' 2008-11-09 - Version 1.0.0  
' 2008-11-21 - Version 1.0.1  
'=====================================================================  

Dim objItem As Object ' Aktuelles Element  
Dim strDispSender As String
Dim i As Long

'---------------------------------------------------------------------  
' Fehlerbehandlung wegen Set-Anweisungen ausschalten  
'---------------------------------------------------------------------  
On Error Resume Next

'---------------------------------------------------------------------  
' Aktuell geöffnetes Element refernzieren  
'---------------------------------------------------------------------  
Set objItem = Outlook.ActiveInspector.CurrentItem

'---------------------------------------------------------------------  
' Wenn kein Element geöffnet ist, dann markiertes verwenden  
'---------------------------------------------------------------------  
If objItem Is Nothing Then Set objItem = Outlook.ActiveExplorer.Selection(1)

'---------------------------------------------------------------------  
' Auch nichts markiert?  
'---------------------------------------------------------------------  
If objItem Is Nothing Then GoTo ExitProc

'---------------------------------------------------------------------  
' Aktuelles Datum [yyyy-mm-dd] und Absender hinzufügen  
'---------------------------------------------------------------------  

' [alt] objItem.Subject = Format(Date, "yyyy-MM-dd") & "  " & objItem.Subject  
objItem.Subject = Format(Date, "yyyy-MM-dd") & "  " & objItem.SenderName & " " & objItem.Subject  

'---------------------------------------------------------------------  
' Nur das was vor dem Komma (soweit vorhanden) im SENDERNAME  
' enthalten ist übernehmen  
'---------------------------------------------------------------------  

i = InStr(1, objItem.SenderName, ",")  
If (i > 0) Then
  strDispSender = Left(objItem.SenderName, i - 1)
Else
  strDispSender = objItem.SenderName
End If

'---------------------------------------------------------------------  
' Prüfung ob es sich um eine Email handelt oder nicht  
'---------------------------------------------------------------------  

If objItem.Class <> olMail Then GoTo ExitProc

'---------------------------------------------------------------------  
' Änderung speichern  
'---------------------------------------------------------------------  
objItem.Save

ExitProc:

'---------------------------------------------------------------------  
' Referenz auf Element löschen  
'---------------------------------------------------------------------  
Set objItem = Nothing

End Sub

Moin TecAttack,

danke für die ausführliche Antwort.
Deine Erwartungshaltung mit dem "Anschubsen in Richtung Lösung" finde ich gut.
Aus meiner Sicht würde es auch nichts bringen, dir einen fertigen Code vor die Füße zu werfen, den du später auch bei kleinen Anpassungen nicht warten kannst - du solltest es auch verstehen.
Und vor allen selbst den Mut/die Neugier zum Experimentieren behalten.

Also, kleine Schubser:

das Datum, das du brauchst... am geeignetesten wäre das Datumsfeld "ReceivedTime" (Ja, es heißt "xxxTime"; ja, es ist ein Datumsfeld ->siehe unter "Redmond" oder "Praktikantenjobs").
Alternativdatum wäre das Datumsfeld "SentOn"... aber mit der Absendezeit tun sich neue Tücken auf. Mache es wie meine Praktikantinnen: achte nur auf die Zeit der Empfängnis, also "ReceivedTime".
das zweite Problem - du extrahierst zwar einen Teilstring des Absendernamens in die Variable "strDispSender", aber diese "strDispSender" wird nie in den neuen Betreff eingebaut.

Die jetzige Zeile 39 (ich hab nochmal Codetags nachgetragen *vorwurfsvoll gugg*), in der der neue Betreff zusammengeschrotet wird, muss NACH der "strDispSender"-Bastelei zu liegen kommen. Und dort muss statt "objItem.Sendername" nun die Variable "strDispSender" rein.

Grüße
Biber

Hey Biber,

Habs mit deinen Schubsern geschafft, vielen Dank! Ich komme mir vor wie der König der Welt!

Nun hab ich schon die nächsten beiden Ideen, den Code zu erweitern und würde mich dann gegebenenfalls melden, falls ich der König es nicht selbst schaffe aber das wär ja wohl gelacht *lach lach* *lach lach*

Danke und Gruß
TecAttack

Hier der fertige und getestete Code:

Public Sub InsertDate()

'=====================================================================  
' Fügt an den Anfang des Betreffs eines Elements das Datum und Nachnamen ein.  
' 2008-11-21 - Version 1.0.0  
'=====================================================================  


Dim objItem As Object ' Aktuelles Element  
Dim strDispSender As String
Dim i As Long

'---------------------------------------------------------------------  
' Fehlerbehandlung wegen Set-Anweisungen ausschalten  
'---------------------------------------------------------------------  
On Error Resume Next

'---------------------------------------------------------------------  
' Aktuell geöffnetes Element refernzieren  
'---------------------------------------------------------------------  
Set objItem = Outlook.ActiveInspector.CurrentItem

'---------------------------------------------------------------------  
' Wenn kein Element geöffnet ist, dann markiertes verwenden  
'---------------------------------------------------------------------  
If objItem Is Nothing Then Set objItem = Outlook.ActiveExplorer.Selection(1)

'---------------------------------------------------------------------  
' Auch nichts markiert?  
'---------------------------------------------------------------------  
If objItem Is Nothing Then GoTo ExitProc

'---------------------------------------------------------------------  
' Nur das was vor dem Komma (soweit vorhanden) im SenderName  
' enthalten ist übernehmen  
'---------------------------------------------------------------------  

i = InStr(1, objItem.SenderName, ",")  
If (i > 0) Then
  strDispSender = Left(objItem.SenderName, i - 1)
Else
  strDispSender = objItem.SenderName
End If

'---------------------------------------------------------------------  
' Aktuelles Datum [yyyy-mm-dd] und Absender hinzufügen  
'---------------------------------------------------------------------  

' [alt] objItem.Subject = Format(Date, "yyyy-MM-dd") & "  " & objItem.Subject  
objItem.Subject = Format(objItem.ReceivedTime, "yyyy-MM-dd") & "  " & strDispSender & " " & objItem.Subject  

'---------------------------------------------------------------------  
' Prüfung ob es sich um eine Email handelt oder nicht  
'---------------------------------------------------------------------  

If objItem.Class <> olMail Then GoTo ExitProc

'---------------------------------------------------------------------  
' Änderung speichern  
'---------------------------------------------------------------------  
objItem.Save

ExitProc:

'---------------------------------------------------------------------  
' Referenz auf Element löschen  
'---------------------------------------------------------------------  
Set objItem = Nothing

End Sub