Deleting Only Attachments of all Outlook Calender Enteries.

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

LVL 6
DooglaveAsked:
Who is Participating?

[Webinar] Streamline your web hosting managementRegister Today

x
 
ioaneConnect With a Mentor Planning & Analytics ManagerCommented:
Do you have an H: drive?
0
 
DooglaveAuthor Commented:
lol, no.  I bet that's it.   Thanks I'll get back to you when I have time to do this again.
0
All Courses

From novice to tech pro — start learning today.