Deleting Only Attachments of all Outlook Calender Enteries.

Posted on 2009-07-02
Last Modified: 2012-05-07
Help get this code working.

I ran the code found in:

When I enter the date in various formats I always get Run-time error 'Cannot save the attachment.'

Debug focus on:
                            .attachments.Item(intCount).SaveAsFile myOrt & _
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"


        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 & _



                            intAttachmentsRemoved = intAttachmentsRemoved + 1



                    End If

                End If

            End With


        If intMsgsInDateRange = 0 Then

            MsgBox "All done.  There were no messages in the date range specified.", vbInformation + vbOKOnly, "Delete Calendar Attachments Macro"


            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

Open in new window

Question by:Dooglave
LVL 13

Accepted Solution

ioane earned 500 total points
ID: 24769713
Do you have an H: drive?

Author Comment

ID: 24795663
lol, no.  I bet that's it.   Thanks I'll get back to you when I have time to do this again.

Featured Post

IT, Stop Being Called Into Every Meeting

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

Join & Write a Comment

Resolve Outlook connectivity issues after moving mailbox to new Exchange 2016 server
Sometimes Outlook might have problems sending a message. There may be various causes- corrupted PST, AV scanner etc. The message, instead of going to the Sent Items folder, sits in the Outbox indefinitely. To remove it you can use a free tool cal…
This Micro Tutorial will demonstrate on a Mac how to change the sort order for chart legend values and decrpyt the intimidating chart menu.
This Micro Tutorial will demonstrate in Microsoft Excel how to add style and sexy appeal to horizontal bar charts.

760 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

20 Experts available now in Live!

Get 1:1 Help Now