Solved

Deleting Only Attachments of all Outlook Calender Enteries.

Posted on 2009-07-02
2
142 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

NFR key for Veeam Backup for Microsoft Office 365

Veeam is happy to provide a free NFR license (for 1 year, up to 10 users). This license allows for the non‑production use of Veeam Backup for Microsoft Office 365 in your home lab without any feature limitations.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Some code to ensure data integrity when using macros within Excel. Also included code that helps secure your data within an Excel workbook.
Do you use a spreadsheet like Microsoft's Excel?  Have you ever wanted to link out to a non excel file on your computer or network drive?  This is the way I found to do it!
This Micro Tutorial will demonstrate in Microsoft Excel how to add style and sexy appeal to horizontal bar charts.
A short tutorial showing how to set up an email signature in Outlook on the Web (previously known as OWA). For free email signatures designs, visit https://www.mail-signatures.com/articles/signature-templates/?sts=6651 If you want to manage em…

830 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