Excelin İçindeyken Outlooktan Mail Silme

[baydeniro]

Merhaba Arkadaşlar,

Aşağıdaki kod ile Excelin içindeyken Outlooktan mail silmenin mümkün olduğu belirtilmiş ama beceremedim.
Bu kodu modüle yazıp, butona bağladım. Ama çalışmadı. Nerede hata yapıyor olabilirim acaba ?

https://www.ozgrid.com/forum/forum/other-software-applications/excel-and-or-email-help/123004-outlook-mail-selection-using-vba
linkindeki 4.mesajda

Public Sub Move_Inbox_Emails_From_Excel()

Dim outApp As Object
Dim outNS As Object
Dim inboxFolder As Object
Dim destFolder As Object
Dim outEmail As Object
Dim inboxItems As Object
Dim i As Integer
Dim inputNumber As String
Dim numberToMove As Integer

inputNumber = InputBox("Enter number of emails to move")
On Error Resume Next
numberToMove = CInt(inputNumber)
On Error GoTo 0
If numberToMove < 1 Then Exit Sub

Set outApp = CreateObject("Outlook.Application")
Set outNS = outApp.GetNamespace("MAPI")
Set inboxFolder = outNS.GetDefaultFolder(olFolderInbox)
Set destFolder = inboxFolder.Parent.Folders("ARŞİV") 'Test folder at same level as Inbox

'Sort Inbox items by Received Time

Set inboxItems = inboxFolder.Items
inboxItems.Sort "[ReceivedTime]", False 'ascending order (oldest first)
'inboxItems.Sort "[ReceivedTime]", True 'descending order (newest first)

'Loop through sorted items for the number entered by the user, up to the number of items in the Inbox

For i = 1 To Application.WorksheetFunction.Min(inboxItems.Count, numberToMove)
Set outEmail = inboxItems(i)
'Debug.Print i, outEmail.Subject
outEmail.Move destFolder
Next
End Sub

 

[PLİNT]

Merhaba
"Gelen" mailler içinse aşağıdaki gibi olabilir

    Set b = CreateObject("Outlook.Application").GetNamespace("MAPI")
    Set c = b.GetDefaultFolder(6)
 For t = c.items.Count To 1 Step -1
sor = MsgBox(c.items(t).Subject & vbCrLf & "Silinsinmi?", vbYesNo)
If sor = vbYes Then c.items(t).Delete
 Next

 

[baydeniro]

PLİNT üstadım ilgine teşekkür ederim. Gelen Kutusu güzel fikir. Acaba konu tanımı veya gövdesinde içerdiği kelimeleri filtreleyerek içerenleri silmesi mümkün olur mu ?

 

[PLİNT]

"İnputbox" 'a konu içeriği yazarak aşağıdaki gibi seçilebilir

   Set b = CreateObject("Outlook.Application").GetNamespace("MAPI")
    Set c = b.GetDefaultFolder(6)
    sor = InputBox("Aranacak Konu Yazınız")
If sor <> Empty Then
sor = WorksheetFunction.Proper(sor)
 For t = c.items.Count To 1 Step -1
 If WorksheetFunction.Proper(c.items(t).Subject) Like sor & "*" Then
 sor = MsgBox(c.items(t).SenderEmailAddress & vbCrLf & "Silinsinmi?", vbYesNo)
If sor = vbYes Then c.items(t).Delete
End If
 Next
 End If

 

[baydeniro]

PLİNT üstadım kod için teşekkürler, güzel çalışıyor. Acaba sormadan silmesi sağlanabilir mi ?

 

[PLİNT]

Kodların içindeki şu iki satır;

 sor = MsgBox(c.items(t).SenderEmailAddress & vbCrLf & "Silinsinmi?", vbYesNo)
If sor = vbYes Then c.items(t).Delete

yerine

c.items(t).delete

Yazarak sormadan sildirebilirsiniz