Top-Themen

Aktuelle Themen (A bis Z)

Administrator.de FeedbackApache ServerAppleAssemblerAudioAusbildungAuslandBackupBasicBatch & ShellBenchmarksBibliotheken & ToolkitsBlogsCloud-DiensteClusterCMSCPU, RAM, MainboardsCSSC und C++DatenbankenDatenschutzDebianDigitiales FernsehenDNSDrucker und ScannerDSL, VDSLE-BooksE-BusinessE-MailEntwicklungErkennung und -AbwehrExchange ServerFestplatten, SSD, RaidFirewallFlatratesGoogle AndroidGrafikGrafikkarten & MonitoreGroupwareHardwareHosting & HousingHTMLHumor (lol)Hyper-VIconsIDE & EditorenInformationsdiensteInstallationInstant MessagingInternetInternet DomäneniOSISDN & AnaloganschlüsseiTunesJavaJavaScriptKiXtartKVMLAN, WAN, WirelessLinuxLinux DesktopLinux NetzwerkLinux ToolsLinux UserverwaltungLizenzierungMac OS XMicrosoftMicrosoft OfficeMikroTik RouterOSMonitoringMultimediaMultimedia & ZubehörNetzwerkeNetzwerkgrundlagenNetzwerkmanagementNetzwerkprotokolleNotebook & ZubehörNovell NetwareOff TopicOpenOffice, LibreOfficeOutlook & MailPapierkorbPascal und DelphiPeripheriegerätePerlPHPPythonRechtliche FragenRedHat, CentOS, FedoraRouter & RoutingSambaSAN, NAS, DASSchriftartenSchulung & TrainingSEOServerServer-HardwareSicherheitSicherheits-ToolsSicherheitsgrundlagenSolarisSonstige SystemeSoziale NetzwerkeSpeicherkartenStudentenjobs & PraktikumSuche ProjektpartnerSuseSwitche und HubsTipps & TricksTK-Netze & GeräteUbuntuUMTS, EDGE & GPRSUtilitiesVB for ApplicationsVerschlüsselung & ZertifikateVideo & StreamingViren und TrojanerVirtualisierungVisual StudioVmwareVoice over IPWebbrowserWebentwicklungWeiterbildungWindows 7Windows 8Windows 10Windows InstallationWindows MobileWindows NetzwerkWindows ServerWindows SystemdateienWindows ToolsWindows UpdateWindows UserverwaltungWindows VistaWindows XPXenserverXMLZusammenarbeit

gelöst Outlook 2003 SP3 - Makro - SenderName im Betreff einfügen

Mitglied: TecAttack

TecAttack (Level 1) - Jetzt verbinden

11.03.2010, aktualisiert 08:42 Uhr, 3637 Aufrufe, 6 Kommentare

Hallo Zusammen,

Das folgende Makro fügt u.a. den Teil des SenderName ein der vor dem Komma ist. Das ist gut so und soll bleiben.

Bsp.:
1) SenderName = "Müller, Peter"
2) Makro laufen lassen
3) Im Betreff erscheint nur "Müller"

Mein Problem nun ist, dass ich auch emails bekomme bei denen SenderName = "Helga Maria Schmidt" ist. Hierfür dachte ich zunächst folgende beiden Lösungsbeschreibungen:
1) Wenn dieser Fall zutrifft müsste alle Zeichen bis zum nächsten Leerzeichen von hinten nach vorne in den Betreff kopiert werden.
2) Wenn dieser Fall zutrifft müssten alle Zeichen nach dem letzten Leerzeichen von vorne nach hinten in den Betreff kopiert werden.

Sollablauf:
1) SenderName = "Helga Maria Schmidt"
2) Makro laufen lassen
3) Im Betreff erscheint nur "Schmidt"

Kann mir jemand weiterhelfen?

Vielen Dank!
TecAttack


01.
Public Sub EditSubject()
02.

03.
'=====================================================================
04.
' Zweck: Betreff wird wird wie folgt editiert:
05.
'
06.
' ErhaltenDatum einfügen 
07.
' SenderName einfügen
08.
' AW, RE & Co löschen
09.
'
10.
' 10 March 2010
11.
'=====================================================================
12.

13.

14.
Dim objItem As Object ' Aktuelles Element
15.
Dim strDispSender As String
16.
Dim i As Long
17.
Dim SubjectText
18.
Dim FindText1, FindText2, FindText3, FindText4, FindText5
19.
Dim DeleteText
20.

21.

22.
'---------------------------------------------------------------------
23.
' Fehlerbehandlung wegen Set-Anweisungen ausschalten
24.
'---------------------------------------------------------------------
25.
On Error Resume Next
26.

27.
'---------------------------------------------------------------------
28.
' Aktuell geöffnetes Element refernzieren
29.
'---------------------------------------------------------------------
30.
Set objItem = Outlook.ActiveInspector.CurrentItem
31.

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

37.
'---------------------------------------------------------------------
38.
' Auch nichts markiert?
39.
'---------------------------------------------------------------------
40.
If objItem Is Nothing Then GoTo ExitProc
41.

42.
'---------------------------------------------------------------------
43.
' AW löschen
44.
'---------------------------------------------------------------------
45.

46.
SubjectText = objItem.Subject
47.
FindText1 = "AW: "
48.
DeleteText = ""
49.
 
50.
objItem.Subject = Replace(SubjectText, FindText1, DeleteText)
51.

52.
'---------------------------------------------------------------------
53.
' WG löschen
54.
'---------------------------------------------------------------------
55.

56.
SubjectText = objItem.Subject
57.
FindText2 = "WG: "
58.
DeleteText = ""
59.
 
60.
objItem.Subject = Replace(SubjectText, FindText2, DeleteText)
61.

62.
'---------------------------------------------------------------------
63.
' RE löschen
64.
'---------------------------------------------------------------------
65.

66.
SubjectText = objItem.Subject
67.
FindText3 = "RE: "
68.
DeleteText = ""
69.
 
70.
objItem.Subject = Replace(SubjectText, FindText3, DeleteText)
71.

72.
'---------------------------------------------------------------------
73.
' TR löschen
74.
'---------------------------------------------------------------------
75.

76.
SubjectText = objItem.Subject
77.
FindText4 = "TR: "
78.
DeleteText = ""
79.
 
80.
objItem.Subject = Replace(SubjectText, FindText4, DeleteText)
81.

82.
'---------------------------------------------------------------------
83.
' Re löschen
84.
'---------------------------------------------------------------------
85.

86.
SubjectText = objItem.Subject
87.
FindText5 = "Re: "
88.
DeleteText = ""
89.
 
90.
objItem.Subject = Replace(SubjectText, FindText5, DeleteText)
91.

92.
'---------------------------------------------------------------------
93.
' RES löschen
94.
'---------------------------------------------------------------------
95.

96.
SubjectText = objItem.Subject
97.
FindText6 = "RES: "
98.
DeleteText = ""
99.
 
100.
objItem.Subject = Replace(SubjectText, FindText6, DeleteText)
101.

102.
'---------------------------------------------------------------------
103.
' FW löschen
104.
'---------------------------------------------------------------------
105.

106.
SubjectText = objItem.Subject
107.
FindText7 = "FW: "
108.
DeleteText = ""
109.
 
110.
objItem.Subject = Replace(SubjectText, FindText7, DeleteText)
111.

112.
'---------------------------------------------------------------------
113.
' RV löschen
114.
'---------------------------------------------------------------------
115.

116.
SubjectText = objItem.Subject
117.
FindText8 = "RV: "
118.
DeleteText = ""
119.
 
120.
objItem.Subject = Replace(SubjectText, FindText8, DeleteText)
121.

122.
'---------------------------------------------------------------------
123.
' Fwd löschen
124.
'---------------------------------------------------------------------
125.

126.
SubjectText = objItem.Subject
127.
FindText9 = "Fwd: "
128.
DeleteText = ""
129.
 
130.
objItem.Subject = Replace(SubjectText, FindText9, DeleteText)
131.

132.
'---------------------------------------------------------------------
133.
' R löschen
134.
'---------------------------------------------------------------------
135.

136.
SubjectText = objItem.Subject
137.
FindText10 = "R: "
138.
DeleteText = ""
139.
 
140.
objItem.Subject = Replace(SubjectText, FindText10, DeleteText)
141.

142.

143.
'---------------------------------------------------------------------
144.
' Nur das was vor dem Komma (soweit vorhanden) im SenderName
145.
' enthalten ist übernehmen
146.
'---------------------------------------------------------------------
147.

148.
i = InStr(1, objItem.SenderName, ",")
149.
If (i > 0) Then
150.
  strDispSender = Left(objItem.SenderName, i - 1)
151.
Else
152.
  strDispSender = objItem.SenderName
153.
End If
154.

155.
'---------------------------------------------------------------------
156.
' Erhalten Datum [yyyy-mm-dd] und obigen SenderName hinzufügen
157.
'---------------------------------------------------------------------
158.

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

162.
'---------------------------------------------------------------------
163.
' Prüfung ob es sich um eine Email handelt oder nicht
164.
'---------------------------------------------------------------------
165.

166.
If objItem.Class <> olMail Then GoTo ExitProc
167.

168.
'---------------------------------------------------------------------
169.
' Änderung speichern
170.
'---------------------------------------------------------------------
171.
objItem.Save
172.

173.
ExitProc:
174.

175.
'---------------------------------------------------------------------
176.
' Referenz auf Element löschen
177.
'---------------------------------------------------------------------
178.
Set objItem = Nothing
179.

180.
End Sub
Mitglied: 76109
11.03.2010 um 09:46 Uhr
Hallo TecAttack!

Beispiel:
01.
Const SenderName = "Helga Maria Schmidt"
02.

03.
Dim Sender As Variant, Betreff As String
04.

05.
Sender = Split(SenderName)  'Default ist Leerzeichen
06.
    
07.
Betreff = Sender(UBound(Sender))    'Betreff = "Schmidt"
Result:
Helga Maria Schmidt = Schmidt
Maria Schmidt = Schmidt
Schmidt = Schmidt

Gruß Dieter
Bitte warten ..
Mitglied: TecAttack
11.03.2010 um 10:08 Uhr
Hallo Dieter,

Vielen Dank !!! Nun hast du mir schon 2 super Tipps/Lösungen gegeben

Für mich Anfänger sind VBA-technisch paar Sachen neu (auch was meine andere Frage angeht). Ich werde mich mal damit beschäftigen und stelle Ergebnis sobald wie möglich rein.

Gruß
TecAttack
Bitte warten ..
Mitglied: 76109
11.03.2010 um 10:40 Uhr
Hallo TecAttack!

Zitat von TecAttack:
Vielen Dank !!! Nun hast du mir schon 2 super Tipps/Lösungen gegeben
Yepp, gern geschehen
Für mich Anfänger sind VBA-technisch paar Sachen neu (auch was meine andere Frage angeht). Ich werde mich mal damit
beschäftigen und stelle Ergebnis sobald wie möglich rein.
Tja, aller Anfang ist schwer, aber mit der Zeit kommt alles wie von selbst

Gruß Dieter
Bitte warten ..
Mitglied: TecAttack
15.03.2010 um 10:46 Uhr
Moin,

Der obige Tipp eingepflegt in den obigen Code ergibt den hier unten folgenden erfolgreich getesteten Code. Nochmal danke Dieter! Deinen anderen Tipp bzgl. "AW, WG,..." muss ich noch einbauen. Meine nächsten Probleme und Fragen stehen schon in den Startlöchern, also bis dahin.

Gruß
TecAttack

01.
Public Sub EditSubject()
02.

03.
'=====================================================================
04.
' Zweck: Betreff wird wird wie folgt editiert:
05.
'
06.
' ErhaltenDatum einfügen
07.
' SenderName einfügen
08.
' AW, RE & Co löschen
09.
'
10.
' 11 March 2010
11.
'=====================================================================
12.

13.

14.
Dim objItem As Object ' Aktuelles Element
15.
Dim strDispSender As String
16.
Dim i As Long
17.
Dim SubjectText
18.
Dim FindText1, FindText2, FindText3, FindText4, FindText5
19.
Dim DeleteText
20.
Dim FullSender As Variant, PartSender As String
21.

22.

23.
'---------------------------------------------------------------------
24.
' Fehlerbehandlung wegen Set-Anweisungen ausschalten
25.
'---------------------------------------------------------------------
26.
On Error Resume Next
27.

28.
'---------------------------------------------------------------------
29.
' Aktuell geöffnetes Element refernzieren
30.
'---------------------------------------------------------------------
31.
Set objItem = Outlook.ActiveInspector.CurrentItem
32.

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

38.
'---------------------------------------------------------------------
39.
' Auch nichts markiert?
40.
'---------------------------------------------------------------------
41.
If objItem Is Nothing Then GoTo ExitProc
42.

43.
'---------------------------------------------------------------------
44.
' AW löschen
45.
'---------------------------------------------------------------------
46.

47.
SubjectText = objItem.Subject
48.
FindText1 = "AW: "
49.
DeleteText = ""
50.
 
51.
objItem.Subject = Replace(SubjectText, FindText1, DeleteText)
52.

53.
'---------------------------------------------------------------------
54.
' WG löschen
55.
'---------------------------------------------------------------------
56.

57.
SubjectText = objItem.Subject
58.
FindText2 = "WG: "
59.
DeleteText = ""
60.
 
61.
objItem.Subject = Replace(SubjectText, FindText2, DeleteText)
62.

63.
'---------------------------------------------------------------------
64.
' RE löschen
65.
'---------------------------------------------------------------------
66.

67.
SubjectText = objItem.Subject
68.
FindText3 = "RE: "
69.
DeleteText = ""
70.
 
71.
objItem.Subject = Replace(SubjectText, FindText3, DeleteText)
72.

73.
'---------------------------------------------------------------------
74.
' TR löschen
75.
'---------------------------------------------------------------------
76.

77.
SubjectText = objItem.Subject
78.
FindText4 = "TR: "
79.
DeleteText = ""
80.
 
81.
objItem.Subject = Replace(SubjectText, FindText4, DeleteText)
82.

83.
'---------------------------------------------------------------------
84.
' Re löschen
85.
'---------------------------------------------------------------------
86.

87.
SubjectText = objItem.Subject
88.
FindText5 = "Re: "
89.
DeleteText = ""
90.
 
91.
objItem.Subject = Replace(SubjectText, FindText5, DeleteText)
92.

93.
'---------------------------------------------------------------------
94.
' RES löschen
95.
'---------------------------------------------------------------------
96.

97.
SubjectText = objItem.Subject
98.
FindText6 = "RES: "
99.
DeleteText = ""
100.
 
101.
objItem.Subject = Replace(SubjectText, FindText6, DeleteText)
102.

103.
'---------------------------------------------------------------------
104.
' FW löschen
105.
'---------------------------------------------------------------------
106.

107.
SubjectText = objItem.Subject
108.
FindText7 = "FW: "
109.
DeleteText = ""
110.
 
111.
objItem.Subject = Replace(SubjectText, FindText7, DeleteText)
112.

113.
'---------------------------------------------------------------------
114.
' RV löschen
115.
'---------------------------------------------------------------------
116.

117.
SubjectText = objItem.Subject
118.
FindText8 = "RV: "
119.
DeleteText = ""
120.
 
121.
objItem.Subject = Replace(SubjectText, FindText8, DeleteText)
122.

123.
'---------------------------------------------------------------------
124.
' Fwd löschen
125.
'---------------------------------------------------------------------
126.

127.
SubjectText = objItem.Subject
128.
FindText9 = "Fwd: "
129.
DeleteText = ""
130.
 
131.
objItem.Subject = Replace(SubjectText, FindText9, DeleteText)
132.

133.
'---------------------------------------------------------------------
134.
' R löschen
135.
'---------------------------------------------------------------------
136.

137.
SubjectText = objItem.Subject
138.
FindText10 = "R: "
139.
DeleteText = ""
140.
 
141.
objItem.Subject = Replace(SubjectText, FindText10, DeleteText)
142.

143.

144.
'---------------------------------------------------------------------
145.
' Nur Nachname kopieren, wenn Komma vorhanden
146.
'---------------------------------------------------------------------
147.

148.
i = InStr(1, objItem.SenderName, ",")
149.
If (i > 0) Then
150.
  strDispSender = Left(objItem.SenderName, i - 1)
151.

152.
objItem.Subject = Format(objItem.ReceivedTime, "yyyy-MM-dd") & "  " & strDispSender & " " & objItem.Subject
153.

154.
Else
155.

156.
'---------------------------------------------------------------------
157.
' Nur Nachname kopieren, wenn KEIN Komma vorhanden
158.
'---------------------------------------------------------------------
159.

160.
FullSender = Split(objItem.SenderName)  'Default ist Leerzeichen 
161.

162.
PartSender = FullSender(UBound(FullSender))    'PartSender = „Nachname“
163.

164.

165.
objItem.Subject = Format(objItem.ReceivedTime, "yyyy-MM-dd") & "  " & PartSender & " " & objItem.Subject
166.

167.
End If
168.

169.

170.
'---------------------------------------------------------------------
171.
' Prüfung ob es sich um eine Email handelt oder nicht
172.
'---------------------------------------------------------------------
173.

174.
If objItem.Class <> olMail Then GoTo ExitProc
175.

176.
'---------------------------------------------------------------------
177.
' Änderung speichern
178.
'---------------------------------------------------------------------
179.
objItem.Save
180.

181.
ExitProc:
182.

183.
'---------------------------------------------------------------------
184.
' Referenz auf Element löschen
185.
'---------------------------------------------------------------------
186.
Set objItem = Nothing
187.

188.
End Sub
Bitte warten ..
Mitglied: 76109
15.03.2010 um 11:14 Uhr
Hallo TecAttack!

Falls die Namen auch Kommas enthalten, könntest Du, wie in diesem Beispiel, um auch dann das gleiche Ergebnis zu erhalten, die Kommas durch Leerzeichen ersetzen.
'FullSender = Split(Replace(objItem.SenderName, ",", " "))

Gruß Dieter
Bitte warten ..
Mitglied: Hody72
28.10.2010 um 10:02 Uhr
Darf ich mich an diesen alten Thread bitte dranhängen? Danke!

mein Problem ist nämlich ähnlich und Folgendes - mein Chef möchte das wir bei Emails immer unser Kürzel - in meinem Fall PH - als erstes in den Email Betreff stellen - also noch vor das RE oder FW. Mails würden also so aussehen:

statt "RE: Bundzettel kindergarten heute" hiesse es "PH - RE: Bundzettel kindergarten heute" und
statt "FW: RE: Bundzettel kindergarten heute" hiesse es "PH - FW: Bundzettel kindergarten heute"
idealerweise sollte auch bei leeren Mails gleich "PH -" in leeren Mailformular stehen.


Lässt sich das irgendwo einstellen - Habe leider keine Ahnung von VBA.

Gibts da eine Lösung?

Vielen vielen Dank im Voraus
Bitte warten ..
Ähnliche Inhalte
Outlook & Mail
Outlook 2016 - Makro
gelöst Frage von apex.predator24Outlook & Mail7 Kommentare

Hallo Zusammen Da es im Outlook keine Funktion oder Möglichkeit existiert, die An- und Rückfahrt von einem Termin separat ...

Outlook & Mail

Outlook 2003 - E-Mailansicht zwei Zeilen - Betreff und Absender vertauscht

gelöst Frage von ExcaliburxOutlook & Mail1 Kommentar

Hallo Zusammen, Outlook 2003 ist im Einsatz mit Exchange. Bei einem Client werden die E-Mails im Ordner Posteingang und ...

Microsoft Office

Outlook 2010 Betreff ändern bzw. einkürzen

gelöst Frage von Denyo25Microsoft Office9 Kommentare

Hallo, ich suche eine Lösung für folgendes. Exchange 2010 Outlook 2010 In ein bestimmtes Postfach kommen Mails mit einem ...

VB for Applications

Vba Outlook Betreff Datum - Absender - Empfänger

Frage von Romy0907VB for Applications7 Kommentare

Hallo liebe Community, ich bin noch sehr neu im Gebiet vba und benötige daher eure Hilfe - es ist ...

Neue Wissensbeiträge
Windows 7
Updategängelung auf Windows 10, die zweite
Information von Penny.Cilin vor 4 TagenWindows 72 Kommentare

Hallo, da Windows 7 im kommenden Jahr nicht mehr supportet wird, werden Nutzer von Window 7 home premium wieder ...

Internet
EU-Urheberrechtsreform: Zusammenfassung
Information von Frank vor 6 TagenInternet1 Kommentar

Auf golem.de gibt es eine Analyse von Friedhelm Greis, der das Thema EU-Urheberrechtsreform gut und strukturiert zusammenfasst. Zwar haben ...

Microsoft Office

Office365 Schwachstellen bei Sicherheit und Datenschutz

Information von Penny.Cilin vor 7 TagenMicrosoft Office9 Kommentare

Auf Heise+ gibt es einen Artikel bzgl. Office365 Schwachstellen. Das ist noch ein Grund mehr seine Daten nicht in ...

Sicherheit
Schwachstellen in VPN Clients
Tipp von transocean vor 9 TagenSicherheit2 Kommentare

Moin, es gibt Sicherheitslücken bei VPN Clients namhafter Hersteller, wie man hier lesen kann. Gruß Uwe

Heiß diskutierte Inhalte
LAN, WAN, Wireless
Notebooks in Firmenwlan authentifizieren
gelöst Frage von EarthShakerLAN, WAN, Wireless17 Kommentare

Guten Tag, unsere Firma möchte gerne flächendeckend WLAN einführen und hat zu diesem Zweck einen Dienstleister beauftragt. Wir benötigen ...

Peripheriegeräte
PS2 Y-Kabel für Maus+Tastatur an PS2 Combo-Anschluss ASUS Prime X370-A
gelöst Frage von Windows10GegnerPeripheriegeräte13 Kommentare

Hallo, ich bin am Überlegen das o.g. Motherboard anzuschaffen. Da ich aber noch PS/2 für Maus+Tastatur benötige (bei optischen ...

Windows 10
Netzlaufwerk verschwindet (aber nur bestimmter Laufwerksbuchstabe)
gelöst Frage von survial555Windows 1010 Kommentare

Hallo, ich habe ein ganz seltsames Problem. Systemumgebung: Server 2012 R2 als DC und Windows 10 Pro als Clients ...

Netzwerkmanagement
Netzwerk vorübergehend weg
Frage von ahstaxNetzwerkmanagement10 Kommentare

Hallo, folgendes Szenario stellt sich dar: Im Netzwerk mit Win7-PCs wurden Switche ausgetauscht. Grundsätzlich funktioniert alles mindestens so gut ...