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 - 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, 3968 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 ..
Neuester Wissensbeitrag
Humor (lol)

Linkliste für Adventskalender

(3)

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

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

Frage von gjhammes zum Thema Outlook & Mail ...

Rechtliche Fragen
Landgericht Köln entdeckt, dass SMS sich löschen lassen (3)

Link von tomolpi zum Thema Rechtliche Fragen ...

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

Frage von maxpoint zum Thema Exchange Server ...

Heiß diskutierte Inhalte
Windows Server
DHCP Server switchen (25)

Frage von M.Marz zum Thema Windows Server ...

SAN, NAS, DAS
gelöst HP-Proliant Microserver Betriebssystem (14)

Frage von Yannosch zum Thema SAN, NAS, DAS ...

Grafikkarten & Monitore
Win 10 Grafikkarte Crash von Software? (13)

Frage von Marabunta zum Thema Grafikkarten & Monitore ...

Windows 7
Verteillösung für IT-Raum benötigt (12)

Frage von TheM-Man zum Thema Windows 7 ...