删除OutLook中的邮件,终于搞定了
有两种方法
1。根据主旨删除Email(Subject 为邮件主旨)
Sub delEmail(Subject As String)
Dim myolApp As New Outlook.Application
Dim myOlExp As Outlook.Explorer
Set myOlExp = myolApp.ActiveExplorer
\'MsgBox myOlExp.CurrentFolder.Name
Dim objMessages As Outlook.Items
Dim objMessage As Outlook.MailItem
Set objMessages = myOlExp.CurrentFolder.Items
Set objMessage = objMessages.Find("[Subject] = """ & Subject & """")
If objMessage Is Nothing Then
\'MsgBox "Not Found"
End If
Do While Not objMessage Is Nothing
\'objMessage.Close
objMessage.Delete
Set objMessage = objMessages.FindNext
Loop
Set objMessage = Nothing
Set objMessages = Nothing
Set myOlExp = Nothing
Set myolApp = Nothing
End Sub
2删除当前打开的Email
Sub delOpenEmail()
Set myolApp = CreateObject("Outlook.Application")
On Error Resume Next
Set myItem = myolApp.ActiveInspector.CurrentItem
myItem.Delete
End Sub
1。根据主旨删除Email(Subject 为邮件主旨)
Sub delEmail(Subject As String)
Dim myolApp As New Outlook.Application
Dim myOlExp As Outlook.Explorer
Set myOlExp = myolApp.ActiveExplorer
\'MsgBox myOlExp.CurrentFolder.Name
Dim objMessages As Outlook.Items
Dim objMessage As Outlook.MailItem
Set objMessages = myOlExp.CurrentFolder.Items
Set objMessage = objMessages.Find("[Subject] = """ & Subject & """")
If objMessage Is Nothing Then
\'MsgBox "Not Found"
End If
Do While Not objMessage Is Nothing
\'objMessage.Close
objMessage.Delete
Set objMessage = objMessages.FindNext
Loop
Set objMessage = Nothing
Set objMessages = Nothing
Set myOlExp = Nothing
Set myolApp = Nothing
End Sub
2删除当前打开的Email
Sub delOpenEmail()
Set myolApp = CreateObject("Outlook.Application")
On Error Resume Next
Set myItem = myolApp.ActiveInspector.CurrentItem
myItem.Delete
End Sub