PDA

Vollständige Version anzeigen : Wiederkehrende Termine löschen


Salkin
29.04.2009, 07:38
Moin,

ich lese mit Hilfe einer Makro Termine aus Excel und trage sie in Outlook ein.
Die Termine werden mit einer Schleife die die Jahre hoch zählt 2009+1, 2010+1 usw. funktioniert einwandfrei.

Für das löschen habe ich nur eine funktionierende Makro, wenn alle Termine in der Excelliste mit Jahreszahl sind. So habe ich den gleichen Termin drei Mal in Excel Bsp:

SpalteA SpalteB

Max Mustermann (1982) 04.01.2009
Max Mustermann (1982) 04.01.2010
Max Mustermann (1982) 04.01.2011

Private Sub CommandButton3_Click()

Worksheets("löschen").Select

Const olFolderCalendar As Integer = 9
Dim olApp As Object
Dim objNS As Object
Dim objFolder As Object
Dim objAlleTermine As Object
Dim objTermin As Object
Dim Zeile
Dim Gegner1

Set olApp = CreateObject("Outlook.Application")
Set objNS = olApp.GetNameSpace("MAPI")
Set objFolder = objNS.GetDefaultFolder(olFolderCalendar)
Set objAlleTermine = objFolder.Items

Zeile = 1

ActiveSheet.Cells(2, 1).Select

Do While (ActiveCell.Offset(0 + Zeile, 0).Value <> "")

Gegner1 = ActiveCell.Offset(0 + Zeile, 0).Value
On Error Resume Next
For Each objTermin In objAlleTermine
If objTermin.Subject = Gegner1 Then
objTermin.Delete
End If
Next


Zeile = Zeile + 1

Loop

End Sub


Wie stelle ich den Code so um, dass die die mehrfache Datenpflege nicht mehr notwendig ist?

Gruß Niklas

EarlFred
29.04.2009, 09:47
Hallo Niklas,

probier mal folgenden Code (ohne Gewähr, da ungetestet):

Option Explicit
Sub löschen()

Worksheets("löschen").Select

Const olFolderCalendar As Integer = 9
Dim olApp As Object
Dim objNS As Object
Dim objFolder As Object
Dim tmp As Long
Dim lngAlleTermine As Long
Dim objAlleTermine As Object
Dim lngCounter As Long

Set olApp = CreateObject("Outlook.Application")
Set objNS = olApp.GetNameSpace("MAPI")
Set objFolder = objNS.GetDefaultFolder(olFolderCalendar)
Set objAlleTermine = objFolder.Items
lngAlleTermine = objFolder.Items.Count
tmp = 0
For lngCounter = lngAlleTermine To 1 Step -1
On Error Resume Next
tmp = WorksheetFunction.Match(objAlleTermine(lngCounter).Subject, Worksheets("löschen").[A:A], 0)
If tmp <> 0 Then
objAlleTermine(lngCounter).Delete
tmp = 0
End If
Next lngCounter
End Sub

Grüße
EarlFred

Salkin
30.04.2009, 07:28
Moin,

er hat keine Termine gelöscht.
Ich benutze das Arbeitsblatt Geburtstage, was ich im Quellcode geändert habe.

Die Daten stehen wie folgt im Arbeitsblatt.

Spalte A Spalte B
30.4 Max Mustermann

Gruß Niklas

EarlFred
30.04.2009, 09:11
Hallo Niklas,

er hat keine Termine gelöscht.

Ja, wundert Dich das wirklich? Selbstverständlich klappt das so nicht, denn:

Ausgangslage, Dein erster Post:
SpalteA SpalteB

Max Mustermann (1982) 04.01.2009

Jetzt, Dein 2. Post:
Spalte A Spalte B
30.4 Max Mustermann

Wenn Du erst schreibst, dass das, was Du suchst, in Spalte A steht und nun auf einmal in Spalte B, dann wirst Du doch sicher erkennen, wo der Fehler liegt, oder?

Und: Wenn Du prüfst, ob etwas GLEICH ist, dann nützt es Dir nichts, wenn Du einmal Max Mustermann (1982) und einmal Max Mustermann hast - diese beiden Werte sind NICHT gleich - das Makro löscht aber nur Termine, wenn deren Subject GLEICH dem Wert in der Tabelle ist.

Tu mir einen Gefallen: Schau Dir meinen Code mal konzentriert an und wenn Du Verständnisprobleme hast, dann frag nach. Ich bin mir ziemlich sicher, dass der Code funktioniert, wenn die Datenbasis korrekt ist...

Grüße
EarlFred

Salkin
30.04.2009, 10:57
Moin EarlFred,

E ntschuldigunges war ganz alleine meine Schuld, das es nicht klappte. Es läuft super schnell vielen Dank.
Ich habe nun zwei Tabellenblätter, einmal zu eintragen und einmal zum löschen,
das ist aber meine Schuld, da ich die die Daten falsch gennant habe.

Gruß Niklas

EarlFred
30.04.2009, 12:35
Hallo Niklas,

Problem zufriedenstellend gelöst? Prima!

Dann wünsch ich viele schöne Geburtstagsfeiern!

Grüße
EarlFred