Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.
Sub DeleteCalendarAttachments() Dim strEnd As String, _ myOrt As String, _ olkCalendar As Outlook.MAPIFolder, _ olkAppointment As Outlook.AppointmentItem, _ intCount As Integer, _ intMsgsInDateRange As Integer, _ intItemsWithAttachments As Integer, _ intAttachmentsRemoved As Integer strEnd = Format(InputBox("Enter the end date (DD/MM/YYYY:)"), "ddddd") 'user input last date to remove appointments If Not IsDate(strEnd) Then MsgBox "No date entered. Run again and enter a date.", vbCritical + vbOKOnly, "DeleteCalnedarAttachments - Error" Else myOrt = "H:\Attachments\" Set olkCalendar = Application.ActiveExplorer.CurrentFolder For Each olkAppointment In olkCalendar.Items With olkAppointment 'Change the dates on the next line as desired If .Start <= CDate(strEnd) Then intMsgsInDateRange = intMsgsInDateRange + 1 If .attachments.Count > 0 Then intItemsWithAttachments = intItemsWithAttachments + 1 For intCount = .attachments.Count To 1 Step -1 .attachments.Item(intCount).SaveAsFile myOrt & _ .attachments.Item(intCount).DisplayName .attachments.Item(intCount).Delete intAttachmentsRemoved = intAttachmentsRemoved + 1 Next .Save End If End If End With Next If intMsgsInDateRange = 0 Then MsgBox "All done. There were no messages in the date range specified.", vbInformation + vbOKOnly, "Delete Calendar Attachments Macro" Else MsgBox "All done!" & vbCrLf & "We removed " & intAttachmentsRemoved & " attachments from " & _ intItemsWithAttachments & " appointments.", vbInformation + vbOKOnly, "Delete Calendar Attachments Macro" End If End If Set olkAppointment = Nothing Set olkCalendar = Nothing End Sub
Add your voice to the tech community where 5M+ people just like you are talking about what matters.
Join the community of 500,000 technology professionals and ask your questions.