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

Frage Entwicklung VB for Applications

Mitglied: TecAttack

TecAttack (Level 1) - Jetzt verbinden

11.03.2010, aktualisiert 08:42 Uhr, 3531 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
Exchange Server
Outlook findet keine Mails mit Bindestrich im Betreff
Frage von Coolhand0Exchange Server

Guten Tag allerseits, Umgebung: Windows 7 bzw. Windows 8, Outlook 2013, Exchange 2010, Mailbox im OnLine Betrieb (ohne Cache) ...

Microsoft Office
Excel 2010 via Makro bedingten Seitenumbruch einfügen
Frage von arduinoMicrosoft Office1 Kommentar

Hallo Ich hab ein ExcelMakro, das ein formatiertes Textfile importiert Jetzt ist der Wunsch, dass nach den Eintritten von ...

Microsoft Office
Bild per Makro in Word 2000 einfügen
gelöst Frage von imebroMicrosoft Office4 Kommentare

Hallo, ich möchte gerne ein Bild (jpg) mit einer Unterschrift per Makro in ein Word-Dokument einfügen. Grundsätzlich funktioniert das ...

Microsoft Office
Makro: Terminübergabe von Excel nach Outlook
gelöst Frage von Tsunami87Microsoft Office7 Kommentare

Hallo liebe Gemeinde, Aufgabenstellung war eine Lösung zu finden was Daten aus Excel in eine Outlookaufgabe schreibt. Eine Lösung ...

Neue Wissensbeiträge
Sicherheits-Tools

Achtung: Sicherheitslücke im FortiClient VPN-Client

Tipp von kgborn vor 8 MinutenSicherheits-Tools

Ich weiß nicht, wie häufig die NextGeneration Endpoint Protection-Lösung von Fortinet in deutschen Unternehmen eingesetzt wird. An dieser Stelle ...

Internet

USA: Die FCC schaff die Netzneutralität ab

Information von Frank vor 14 StundenInternet2 Kommentare

Jetzt beschädigt US-Präsident Donald Trump auch noch das Internet. Der neu eingesetzte FCC-Chef Ajit Pai ist bekannter Gegner einer ...

DSL, VDSL

ALL-BM200VDSL2V - Neues VDSL-Modem mit Vectoring von Allnet

Information von Lochkartenstanzer vor 17 StundenDSL, VDSL1 Kommentar

Moin, Falls jemand eine Alternative zu dem draytek sucht: Gruß lks

Windows 10

Microsoft bestätigt DMA-Policy-Problem in Win10 v1709

Information von DerWoWusste vor 18 StundenWindows 10

Wer sein Gerät mit der DMA-Policy absichert, bekommt evtl. Hardwareprobleme in v1709 von Win10. Warum? Weil v1709 endlich "richtig" ...

Heiß diskutierte Inhalte
Netzwerkmanagement
Mehrere Netzwerkadapter in einem PC zu einem Switch zusammenfügen
Frage von prodriveNetzwerkmanagement21 Kommentare

Hallo zusammen Vorweg, ich konnte schon einige IT-Probleme mit Hilfe dieses Forums lösen. Wirklich klasse hier! Doch für das ...

Hardware
Links klick bei Maus funktioniert nicht
gelöst Frage von Pablu23Hardware16 Kommentare

Hallo erstmal. Ich habe ein Problem mit meiner relativ alten maus jedoch denke ich nicht das es an der ...

Windows Server
Anmeldung direkt am DC nicht möglich
Frage von ThomasGrWindows Server16 Kommentare

Hallo, ich habe bei unserem Server 2016 Standard ein Problem. Keine Ahnung wie das auf einmal passiert ist. Ich ...

TK-Netze & Geräte
VPN-fähige IP-Telefone
Frage von the-buccaneerTK-Netze & Geräte14 Kommentare

Hi! Weiss noch jemand ein VPN-fähiges IP-Telefon mit dem man z.B. einen Heimarbeitsplatz gesichert anbinden könnte? Habe nur einen ...