[Outlook] Kontakte löschen

[Oeuf]

Hallo zusammen,

ich habe ein Problem. Ich will mit einem VB6 Programm alle Kontakte in Outlook-Kontaktordner löschen. Doch mit dem Code den ich habe, löscht es mir nur jeden 2. Kontakt. Weiss jemand, wo der Fehler liegen könnte?

Der Code:

Dim olAppl As Outlook.Application
Dim olNS As Outlook.NameSpace
Dim olMAPIFolder As Outlook.MAPIFolder
Dim olItems As Outlook.Items
Dim olResItems As Outlook.Items
Dim olContact As Outlook.ContactItem
Dim sFilter As String

Private Sub Command1_Click()
Set olAppl = CreateObject("Outlook.Application.10")
Set olNS = olAppl.GetNamespace("MAPI")
Set olMAPIFolder = olNS.GetDefaultFolder(olFolderContacts)
Set olItems = olMAPIFolder.Folders.Item("MeineKontakte").Items

sFilter = "[MessageClass] = 'IPM.Contact'"

Set olResItems = olItems.Restrict(sFilter)

For Each olContact In olResItems
olContact.Delete
Next olContact

Set olResItems = Nothing
Set olItems = Nothing
Set olMAPIFolder = Nothing
Set olNS = Nothing
Set olAppl = Nothing


MsgBox "Alle Kontakte gelöscht"
End Sub

 

[NRFi]

wahrscheinlich weil du next olContact sagst, springt der gleich zum nächsten. versuch es mal nur mit next

 

[Oeuf]

ne, habe ich auch schon probiert. Hat leider keine Wirkung. Es wird immer noch jeder 2. Kontakt gelöscht

 

[NRFi]

vielleicht ist das auch so, weil du immer eins löscht und der dann dabei durcheinander kommt..

benutz mal lieber for i = 1 to olResItems.count oder so

 

[Oeuf]

Vielen Dank!

Der Tipp hat mir sehr geholfen. Habe es aber jetzt ein bisschen anders probiert.

While olResItems.Count > 0
Set olContact = olResItems.GetLast
olContact.Delete
Wend


So läuft das einwandfrei



mfg Oeuf