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 - AW oder WG im Betreff löschen lassen

Mitglied: TecAttack

TecAttack (Level 1) - Jetzt verbinden

10.03.2010 um 10:13 Uhr, 4297 Aufrufe, 5 Kommentare

Hallo,

Ich bekomme Emails mit unter anderem "AW: " und/oder "WG: " im Betreff, teilweise auch mehrfach im Betreff. Diese beiden Zusätze "AW: " und/oder "WG: " und andere würde ich gerne von einem Makro erkennen und entfernen lassen.
Leider muss ich sagen, dass ich nicht einmal weiß womit ich anfangen soll (bin Anfänger). Hab im Internet bisher nichts brauchbares gefunden

Das ganze würd ich in den unten angegebenen Code einpflegen wollen. Kann mir jemand auf die Sprünge helfen?

Gruß
TecAttack


01.
Public Sub InsertDate()
02.

03.
'=====================================================================
04.
' Fügt an den Anfang des Betreffs eines Elements das ErhaltenDatum & SenderName ein.
05.
' 2008-11-21 - Version 1.0.0
06.
'=====================================================================
07.

08.

09.
Dim objItem As Object ' Aktuelles Element
10.
Dim strDispSender As String
11.
Dim i As Long
12.

13.
'---------------------------------------------------------------------
14.
' Fehlerbehandlung wegen Set-Anweisungen ausschalten
15.
'---------------------------------------------------------------------
16.
On Error Resume Next
17.

18.
'---------------------------------------------------------------------
19.
' Aktuell geöffnetes Element refernzieren
20.
'---------------------------------------------------------------------
21.
Set objItem = Outlook.ActiveInspector.CurrentItem
22.

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

28.
'---------------------------------------------------------------------
29.
' Auch nichts markiert?
30.
'---------------------------------------------------------------------
31.
If objItem Is Nothing Then GoTo ExitProc
32.

33.
'---------------------------------------------------------------------
34.
' Nur das was vor dem Komma (soweit vorhanden) im SenderName
35.
' enthalten ist übernehmen
36.
'---------------------------------------------------------------------
37.

38.
i = InStr(1, objItem.SenderName, ",")
39.
If (i > 0) Then
40.
  strDispSender = Left(objItem.SenderName, i - 1)
41.
Else
42.
  strDispSender = objItem.SenderName
43.
End If
44.

45.
'---------------------------------------------------------------------
46.
' Erhalten Datum [yyyy-mm-dd] und obigen SenderName hinzufügen
47.
'---------------------------------------------------------------------
48.

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

52.
'---------------------------------------------------------------------
53.
' Prüfung ob es sich um eine Email handelt oder nicht
54.
'---------------------------------------------------------------------
55.

56.
If objItem.Class <> olMail Then GoTo ExitProc
57.

58.
'---------------------------------------------------------------------
59.
' Änderung speichern
60.
'---------------------------------------------------------------------
61.
objItem.Save
62.

63.
ExitProc:
64.

65.
'---------------------------------------------------------------------
66.
' Referenz auf Element löschen
67.
'---------------------------------------------------------------------
68.
Set objItem = Nothing
69.

70.
End Sub
Mitglied: TecAttack
10.03.2010 um 14:20 Uhr
Hallo,

Dieses hier ist nun mein erster Lösungsansatz:

01.
Dim SubjectText, FindText, DeleteText
02.
    
03.
SubjectText = objItem.Subject
04.
FindText = "AW:"
05.
DeleteText = "Delete"
06.
 
07.
objItem.Subject = Replace (SubjectText, FindText, DeleteText)    ' AW löschen
Nun muss ich überlegen/testen ob das alles so schlau ist und wie ich es ins zuvor vorgestellte Makro reinpflege.
Für etwas Unterstützung wäre ich echt dankbar, sonst bastel ich noch nächstes dran rum

Gruß
TecAttack
Bitte warten ..
Mitglied: TecAttack
10.03.2010 um 16:11 Uhr
Hallo TecAttack,

Dein Ansatz ist mehr als gut, ich habs mal in deinen anfangs gezeigten Code eingepflegt, hier unten ist das getestete und funktionierende Ergebnis!

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.
' 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
Bitte warten ..
Mitglied: 76109
10.03.2010 um 21:59 Uhr
Hallo TecAttack!

Wobei man den Entfernen-Vorgang etwas verkürzen könnte:
01.
Const FindText = "AW, WG, RE, TR, RES, FW, RV, FWD, R"     'Komma als Trennzeichen
02.

03.
Dim ReplaceText As Variant, i As Integer
04.
    
05.
ReplaceText = Split(FindText, ",")    'FindText in ein Array splitten
06.
    
07.
For i = 0 To UBound(ReplaceText)    'Alle Elemente plus Doppelpunkt und Leerzeichen entfernen 
08.
        objItem.Subject = Replace(objItem.Subject, Trim(ReplaceText(i)) & ": ", "", , , vbTextCompare)
09.
Next
Durch die Option [vbTextCompare], wird nicht zwischen Groß/Kleinschreibung unterschieden

Gruß Dieter
Bitte warten ..
Mitglied: TecAttack
11.03.2010 um 08:00 Uhr
Guten Morgen Dieter,

Vielen Dank für die Kurzversion! Ich versuch es mal einzupflegen.

Gruß
TecAttack
Bitte warten ..
Mitglied: TecAttack
15.03.2010 um 11:29 Uhr
Moin,

Der Versuch war erfolgreich, hier unten nun das Ergebnis.

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.
' 15 March 2010
11.
'=====================================================================
12.

13.
Const FindText = "AW, WG, RE, TR, RES, FW, RV, FWD, R"    'Komma als Trennzeichen
14.

15.
Dim ReplaceText As Variant, k As Integer 
16.
Dim objItem As Object ' Aktuelles Element
17.
Dim strDispSender As String
18.
Dim i As Long
19.
Dim FullSender As Variant, PartSender As String
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, WG, usw. löschen
44.
'---------------------------------------------------------------------
45.

46.
ReplaceText = Split(FindText, ",")    'FindText in ein Array splitten 
47.

48.
For k = 0 To UBound(ReplaceText)    'Alle Elemente plus Doppelpunkt und Leerzeichen entfernen  
49.

50.
objItem.Subject = Replace(objItem.Subject, Trim(ReplaceText(k)) & ": ", "", , , vbTextCompare)   'Durch die Option [vbTextCompare], wird nicht zwischen Groß/Kleinschreibung unterschieden
51.

52.
Next
53.

54.

55.
'---------------------------------------------------------------------
56.
' Nur Nachname kopieren, wenn Komma vorhanden
57.
'---------------------------------------------------------------------
58.

59.
i = InStr(1, objItem.SenderName, ",")
60.
If (i > 0) Then
61.
  strDispSender = Left(objItem.SenderName, i - 1)
62.

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

65.
Else
66.

67.
'---------------------------------------------------------------------
68.
' Nur Nachname kopieren, wenn KEIN Komma vorhanden
69.
'---------------------------------------------------------------------
70.

71.
FullSender = Split(objItem.SenderName)  'Default ist Leerzeichen 
72.

73.
PartSender = FullSender(UBound(FullSender))    'PartSender = „Nachname“
74.

75.

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

78.
End If
79.

80.

81.
'---------------------------------------------------------------------
82.
' Prüfung ob es sich um eine Email handelt oder nicht
83.
'---------------------------------------------------------------------
84.

85.
If objItem.Class <> olMail Then GoTo ExitProc
86.

87.
'---------------------------------------------------------------------
88.
' Änderung speichern
89.
'---------------------------------------------------------------------
90.
objItem.Save
91.

92.
ExitProc:
93.

94.
'---------------------------------------------------------------------
95.
' Referenz auf Element löschen
96.
'---------------------------------------------------------------------
97.
Set objItem = Nothing
98.

99.
End Sub
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 1 TagWindows 7

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 3 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 4 TagenMicrosoft Office7 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 6 TagenSicherheit2 Kommentare

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

Heiß diskutierte Inhalte
Notebook & Zubehör
Hardware defekt ?
Frage von mausemuckelNotebook & Zubehör14 Kommentare

Hallo und ein schönes Osterfest an alle. Ich benötige mal euer Schwarm wissen. Ich habe hier ein Notebook Lenovo ...

LAN, WAN, Wireless
Lancom und VLANs
Frage von TimmheLAN, WAN, Wireless11 Kommentare

Hallo an alle ich habe momentan ein sehr merkwürdiges problem bei dem ich nicht mehr weiter komme und hoffe ...

Netzwerkmanagement
Konfiguration von IPv6 in einer Domäne mit DHCP
Frage von gnoovyNetzwerkmanagement10 Kommentare

Hi Zusammen, ich bin gerade etwas am verzweifeln. Ich habe eine Testumgebung aufgebaut, um mich in das Thema IPv6 ...

Virtualisierung
Unix System virtualisieren
Frage von BananenmeisterVirtualisierung10 Kommentare

Hallo Zusammen, Ich möchte gerne eine Virtualisierungs-Software auf meinem kleinen ML Server installieren um einige Unix Systeme zu virtualisieren. ...