Top-Themen

AppleEntwicklungHardwareInternetLinuxMicrosoftMultimediaNetzwerkeOff TopicSicherheitSonstige SystemeVirtualisierungWeiterbildungZusammenarbeit

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

Frage Entwicklung VB for Applications

Mitglied: TecAttack

TecAttack (Level 1) - Jetzt verbinden

10.03.2010 um 10:13 Uhr, 4062 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
Mails lassen sich unter Outlook 2013 nicht löschen (2)

Frage von achklein zum Thema Outlook & Mail ...

Microsoft Office
gelöst Outlook 2010 Betreff ändern bzw. einkürzen (9)

Frage von Denyo25 zum Thema Microsoft Office ...

Outlook & Mail
gelöst E-Mail-Postfächer lassen sich in Outlook 2016 nicht löschen (4)

Frage von achimvanveen zum Thema Outlook & Mail ...

Microsoft Office
Outlook Automation Mail-Element löschen (1)

Frage von TestsubjektX zum Thema Microsoft Office ...

Neue Wissensbeiträge
Windows 10

Neues Win10 Funktionsupdate verbuggt RemoteApp

Information von thomasreischer zum Thema Windows 10 ...

Microsoft

Die neuen RSAT-Tools für Win10 1709 sind da

(1)

Information von DerWoWusste zum Thema Microsoft ...

Humor (lol)

Wohnt jemand in Belgien und kann nicht mehr ruhig ausschlafen?

(6)

Information von LordGurke zum Thema Humor (lol) ...

Heiß diskutierte Inhalte
Router & Routing
Allnet - VDSL2 Modem - SFP (mini-GBIC) (19)

Frage von Dobby zum Thema Router & Routing ...

Voice over IP
DeutschlandLAN IP Voice Data M Premium, Erfahrung mit Faxgeräte? (17)

Frage von liquidbase zum Thema Voice over IP ...

TK-Netze & Geräte
TK-Anlage VoIP - DECT Erweiterung (15)

Frage von Lynkon zum Thema TK-Netze & Geräte ...