From this Excel macro, I want to loop through Outlook's default Deleted Items folder and remove only the items that are Contacts.
I've worked out how to remove all items, but not just the Contact items.
I'd be grateful if someone could help me with this.
Sub Remove_Contacts_From_Deleted_Items_Folder()
Dim oApplOutlook As Object
Dim oNsOutlook As Object
Dim oDelFolder As Object
Dim oDelItems As Object
Dim i As Long
Dim lngCount As Long
On Error Resume Next
Set oApplOutlook = GetObject(, "Outlook.Application")
If Err.Number <> 0 Then
Set oApplOutlook = CreateObject("Outlook.Application")
End If
On Error GoTo 0
Set oNsOutlook = oApplOutlook.GetNamespace("MAPI")
Set oDelFolder = oNsOutlook.GetDefaultFolder(3) ' 3 = Deleted Items folder.
Set oDelItems = oDelFolder.Items
' This removes ALL deleted items:
' c = oDelItems.Count
' For n = c To 1 Step -1
' oDelItems.Delete
' Next n
' But I only want to remove any "Contact" items.
' I'm not sure how, but something like this:
For Each oDelItems In oDelFolder
If oDelItems = OutlookContact Then
oDelItems.Delete
End If
Next
End Sub
I've worked out how to remove all items, but not just the Contact items.
I'd be grateful if someone could help me with this.
Sub Remove_Contacts_From_Deleted_Items_Folder()
Dim oApplOutlook As Object
Dim oNsOutlook As Object
Dim oDelFolder As Object
Dim oDelItems As Object
Dim i As Long
Dim lngCount As Long
On Error Resume Next
Set oApplOutlook = GetObject(, "Outlook.Application")
If Err.Number <> 0 Then
Set oApplOutlook = CreateObject("Outlook.Application")
End If
On Error GoTo 0
Set oNsOutlook = oApplOutlook.GetNamespace("MAPI")
Set oDelFolder = oNsOutlook.GetDefaultFolder(3) ' 3 = Deleted Items folder.
Set oDelItems = oDelFolder.Items
' This removes ALL deleted items:
' c = oDelItems.Count
' For n = c To 1 Step -1
' oDelItems.Delete
' Next n
' But I only want to remove any "Contact" items.
' I'm not sure how, but something like this:
For Each oDelItems In oDelFolder
If oDelItems = OutlookContact Then
oDelItems.Delete
End If
Next
End Sub