Top-Themen

AppleEntwicklungHardwareInternetLinuxMicrosoftMultimediaNetzwerkeOff TopicSicherheitSonstige SystemeVirtualisierungWeiterbildungZusammenarbeit

Aktuelle Themen

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

Frage Entwicklung VB for Applications

Mitglied: TecAttack

TecAttack (Level 1) - Jetzt verbinden

11.03.2010, aktualisiert 08:42 Uhr, 3465 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 ..
Neuester Wissensbeitrag
Internet

Unbemerkt - Telekom Netzumschaltung! - BNG - Broadband Network Gateway

(3)

Erfahrungsbericht von ashnod zum Thema Internet ...

Ähnliche Inhalte
Outlook & Mail
Kein Mailversand mit Outlook 2003 (15)

Frage von gjhammes zum Thema Outlook & Mail ...

Exchange Server
Exchange 2010 SP3 UR14 Outlook 2010 Cache Mode (2)

Frage von maxpoint zum Thema Exchange Server ...

Windows Server
gelöst Gruppenrichtlinien-Vorlage Office 2013 auf einem DC 2003 (5)

Frage von bluepython zum Thema Windows Server ...

Heiß diskutierte Inhalte
Switche und Hubs
Trunk für 2xCisco Switch. Wo liegt der Fehler? (17)

Frage von JayyyH zum Thema Switche und Hubs ...

Windows Server
Outlook Verbindungsversuch mit Exchange (15)

Frage von xbast1x zum Thema Windows Server ...

DSL, VDSL
DSL-Signal bewerten (14)

Frage von SarekHL zum Thema DSL, VDSL ...