Helpful to verify reports of your own downtime, or to double check a downed website you are trying to access.
One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.
Public Sub StripAttachments(objmail As MailItem) Dim objOL As Outlook.Application Dim objMsg As Object Dim objAttachments As Outlook.Attachments Dim objSelection As Outlook.Selection Dim i As Long Dim lngCount As Long Dim strFile As String Dim strFolder As String On Error Resume Next ' Instantiate an Outlook Application object. Set objOL = CreateObject("Outlook.Application") ' Get the collection of selected objects. Set objSelection = objOL.ActiveExplorer.Selection ' Get the Temp folder. strFolder = "\\ethserver2\ifshare\reports\" If strFolder = "" Then MsgBox "Could not get Temp folder", vbOKOnly GoTo ExitSub End If ' Check each selected item for attachments. ' If attachments exist, save them to the Temp ' folder and strip them from the item. For Each objMsg In objSelection ' This code only strips attachments from mail items. If objMsg.Class = olMail Then ' Get the Attachments collection of the item. Set objAttachments = objMsg.Attachments lngCount = objAttachments.Count If lngCount > 0 Then ' We need to use a count down loop for ' removing items from a collection. Otherwise, ' the loop counter gets confused and only every ' other item is removed. For i = lngCount To 1 Step -1 ' Save attachment before deleting from item. ' Get the file name. strFile = objAttachments.Item(i).FileName ' Combine with the path to the Temp folder. strFile = strFolder & strFile ' Save the attachment as a file. objAttachments.Item(i).SaveAsFile strFile ' Delete the attachment. objAttachments.Item(i).Delete Next i End If objMsg.Save End If Next ExitSub: Set objAttachments = Nothing Set objMsg = Nothing Set objSelection = Nothing Set objOL = Nothing End Sub