Excel email vba question

[Cooperaac]

Hi,

I am trying to find some code that will loop through any open draft emails I have and use the .close function on any without an attachment. Any ideas?

 

[ZVI]

Hi and welcome to MrExcel board!
Play with the below code:

Sub CloseWithoutAttachments()
  Const olMail = 43, olDiscard = 1, olPromptForSave = 2
  Dim i As Long
  Dim Inspector As Object
  On Error Resume Next
  With GetObject(, "Outlook.Application")
    If Err Then
      MsgBox "Outlook not open", vbExclamation, "Exit"
      Exit Sub
    End If
    For Each Inspector In .Inspectors
      With Inspector.CurrentItem
        If .Class = olMail Then
          If .Attachments.Count = 0 Then
            i = i + 1
            Inspector.Close olDiscard ' or use olPromptForSave instead of olDiscard
          End If
        End If
      End With
    Next
  End With
  MsgBox "Closed emails without attachments: " & i, vbInformation
End Sub

Regards

 

[Cooperaac]

Hi and welcome to MrExcel board!
Play with the below code:

Sub CloseWithoutAttachments()
  Const olMail = 43, olDiscard = 1, olPromptForSave = 2
  Dim i As Long
  Dim Inspector As Object
  On Error Resume Next
  With GetObject(, "Outlook.Application")
    If Err Then
      MsgBox "Outlook not open", vbExclamation, "Exit"
      Exit Sub
    End If
    For Each Inspector In .Inspectors
      With Inspector.CurrentItem
        If .Class = olMail Then
          If .Attachments.Count = 0 Then
            i = i + 1
            Inspector.Close olDiscard ' or use olPromptForSave instead of olDiscard
          End If
        End If
      End With
    Next
  End With
  MsgBox "Closed emails without attachments: " & i, vbInformation
End Sub

Regards

Hi, just a quick one is this based on using the code from excel or imbedded in outlook?

 

[ZVI]

Hi, just a quick one is this based on using the code from excel or imbedded in outlook?

It does not matter - code works in Excel as well as in Outlook

 

[Cooperaac]

Hi,

I have this running and have adjusted the code as below but it only ever clears half of the emails, if i have 4 open it will only close 2 windows and leave the other two open? is there a different way to make this loop?

Sub EmailClose_Loop()
Const olMail = 43, olDiscard = 1, olPromptForSave = 2
Dim i As Long
Dim Inspector As Object
On Error Resume Next
With Outlook.Application
If Err Then
MsgBox "Outlook not open", vbExclamation, "Exit"
Exit Sub
End If
For Each Inspector In .Inspectors
With Inspector.CurrentItem
If .Class = olMail Then
If .Attachments.Count = 0 Then
i = i + 1
Inspector.Close olDiscard '
End If
End If
End With
Next
End With
MsgBox "Closed emails without attachments: " & i, vbInformation
End Sub

Thanks
Adam