Solved

Deleting Only Attachments of all Outlook Calender Enteries.

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

I ran the code found in: http://www.experts-exchange.com/Software/Office_Productivity/Groupware/Outlook/Q_23710781.html?sfQueryTermInfo=1+attach+delet+outlook

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 & _
                            .attachments.Item(intCount).DisplayName
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

Open in new window

0
Comment
Question by:Dooglave
2 Comments
 
LVL 13

Accepted Solution

by:
ioane earned 500 total points
ID: 24769713
Do you have an H: drive?
0
 
LVL 6

Author Comment

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

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