22046_autoimport.rar
Na ten odkaz jsem nekoukal, ale mazání (přepisování) kontaktů je zvláštní. Nicméně může být.
Jestli to jde jedním krokem, nevím. Nepřišel jsem na to a nemyslím si to. Takže je třeba cyklus - se divím, že to Palooo ještě nevytvořil, cykly jsou jeho parketa ;))
Zkoušel jsem for each, ale nebylo to spolehlivé, takže klasicky for.
Sub subDeleteContacts()
Const olFolderContacts As Byte = 10
Dim olApp As Object
On Error Resume Next
Set olApp = GetObject(, "Outlook.Application")
If olApp Is Nothing Then
Set olApp = CreateObject("Outlook.Application")
End If
On Error GoTo 0
Dim olFolder As Object
Set olFolder = olApp.GetNamespace("MAPI").GetDefaultFolder(olFolderContacts)
Dim I As Integer
For I = olFolder.Items.Count To 1 Step -1
olFolder.Items(I).Delete
Next I
Set olFolder = Nothing
Set olApp = Nothing
End Sub
V kontaktech nemám podsložky a vytvářet si je se mi nechce - pokud je tam máte, možná to bude potřeba trochu upravit.citovat
Jestli to jde jedním krokem, nevím. Nepřišel jsem na to a nemyslím si to. Takže je třeba cyklus - se divím, že to Palooo ještě nevytvořil, cykly jsou jeho parketa ;))
Zkoušel jsem for each, ale nebylo to spolehlivé, takže klasicky for.
Sub subDeleteContacts()
Const olFolderContacts As Byte = 10
Dim olApp As Object
On Error Resume Next
Set olApp = GetObject(, "Outlook.Application")
If olApp Is Nothing Then
Set olApp = CreateObject("Outlook.Application")
End If
On Error GoTo 0
Dim olFolder As Object
Set olFolder = olApp.GetNamespace("MAPI").GetDefaultFolder(olFolderContacts)
Dim I As Integer
For I = olFolder.Items.Count To 1 Step -1
olFolder.Items(I).Delete
Next I
Set olFolder = Nothing
Set olApp = Nothing
End Sub
V kontaktech nemám podsložky a vytvářet si je se mi nechce - pokud je tam máte, možná to bude potřeba trochu upravit.citovat
RSS nejnovější články