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

Frage Entwicklung VB for Applications

Mitglied: TecAttack

TecAttack (Level 1) - Jetzt verbinden

10.03.2010 um 10:13 Uhr, 4081 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
Frage von achkleinOutlook & Mail2 Kommentare

Hallo, ich habe auf einem PC Windows 10 und Office 2013 neu installiert. Unter Outlook werden drei Konten genutzt. ...

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) ...

Outlook & Mail
E-Mail-Postfächer lassen sich in Outlook 2016 nicht löschen
gelöst Frage von achimvanveenOutlook & Mail4 Kommentare

Hallo zusammen, ich möchte gerne E-Mail-Adressen löschen, die ich nicht mehr benötige. Versuche ich diese über die rechte Maustaste ...

Windows 7
Programmeinträge lassen sich nicht löschen
gelöst Frage von didisteiWindows 73 Kommentare

Guten Tag. Leider lassen sich bei mir einige Programmeinträge in Windows 7 64-bit unter "Systemsteuerung","Programme deinstallieren" nicht löschen obwohl ...

Neue Wissensbeiträge
Apple

IOS 11.2.1 stopft HomeKit-Remote-Lücke

Tipp von BassFishFox vor 16 StundenApple

Das Update für iPhone, iPad und Apple TV soll die Fernsteuerung von Smart-Home-Geräten wieder in vollem Umfang ermöglichen. Apple ...

Windows 10

Windows 10 v1709 EN murkst bei den Regionseinstellungen

Tipp von DerWoWusste vor 21 StundenWindows 10

Dieser kurze Tipp richtet sich an den kleinen Personenkreis, der Win10 v1709 EN-US frisch installiert und dabei die englische ...

Webbrowser

Kein Ton bei Firefox Quantum über RDP

Tipp von Moddry vor 21 StundenWebbrowser

Hallo Kollegen! Hatte das Problem, dass der neue Firefox bei mir auf der Kiste keinen Ton hat, wenn ich ...

Internet

EU-DSGVO: WHOIS soll weniger Informationen liefern

Information von sabines vor 1 TagInternet4 Kommentare

Wegen der europäische Datenschutzgrundverordnung stehen die Prozesse um die Registrierung von Domains auf dem Prüfstand. Sollte die Forderungen umgesetzt ...

Heiß diskutierte Inhalte
Windows Server
RODC kann nicht aus Domäne entfernt werden
Frage von NilsvLehnWindows Server18 Kommentare

HAllo, ich arbeite in einem Universitätsnetzwerk mit 3 Standorten. Die Standorte haben alle ein ESXi Cluster und auf diesen ...

Windows XP
Windows XP Aktivieren geht nicht
Frage von tetikmiroWindows XP13 Kommentare

Hallo Ich habe einen Windows XP mit einen vCenter Converter umgezogen auf eine ESXI. Soweit funktioniert dies auch ohne ...

Blogs
Immer wiederkehrende PHP Fehlermeldung bei Wordpress UTF-8 - ASCII
gelöst Frage von vcdweltBlogs11 Kommentare

Hi, seit einiger Zeit wird mein error_log meines Wordpress Blogs mit immer der gleichen Fehlermeldung überschwemmt. 14-Dec-2017 08:18:05 UTC ...

Switche und Hubs
Redundante L2 LWL Leitung über 2 Standorte - Spanning Tree - HP Equipment
gelöst Frage von ResolvSwitche und Hubs10 Kommentare

Hallo, ich stehe vor der Herausforderung eine Redundante L2 LWL Leitung über 2 Standorte herzustellen. Grundsätzliches Switching Know How ...