CODEWITHSUNDEEP
vbaoutlook
VeryBasicApplication
VeryBasicApplication

Reputation: 31

Fixing Next Without For Error

This code is meant to save attachments from selected items in Outlook 2010 to a folder in My Documents. I ran into a problem using the previous iteration that 

Dim itm As Outlook.MailItem

My best guess as to why it failed to save attachments is there were some calendar invites mixed in, some of which had attachments. I modified the code to try and address this and have been getting Next Without For errors. 

Public Sub saveAttachtoDisk()
Dim objOL As Outlook.Application
Dim objItems As Outlook.Items
Dim objFolder As Outlook.MAPIFolder
Dim obj As Object
Dim currentExplorer As Explorer
Dim Selection As Selection
Dim objAtt As Outlook.Attachment
Dim saveFolder As String
Dim fso As Object
Dim oldName
Dim file As String
Dim DateFormat As String
Dim newName As String

Dim enviro As String
enviro = CStr(Environ("USERPROFILE"))
saveFolder = enviro & "\Documents\Attachments\"

Set objOL = Outlook.Application
Set objFolder = objOL.ActiveExplorer.CurrentFolder
Set objItems = objFolder.Items

Set fso = CreateObject("Scripting.FileSystemObject")

For Each obj In objItems

    With obj
        For Each objAtt In itm.Attachments

            file = saveFolder & objAtt.DisplayName
            objAtt.SaveAsFile file

            'Get the file name
            Set oldName = fso.GetFile(file)
            x = 1
            Saved = False

            DateFormat = Format(oldName.DateLastModified, "yyyy-mm-dd ")
            newName = DateFormat & objAtt.DisplayName

            'See if file name  exists
            If FileExist(saveFolder & newName) = False Then
                oldName.Name = newName
                GoTo NextAttach
            End If

            'Need a new filename
            Count = InStrRev(newName, ".")
            FnName = Left(newName, Count - 1)
            fileext = Right(newName, Len(newName) - Count + 1)
            Do While Saved = False
                If FileExist(saveFolder & FnName & x & fileext) = False Then
                    oldName.Name = FnName & x & fileext
                    Saved = True
                Else
                    x = x + 1
                End If
            Loop

NextAttach:
Set objAtt = Nothing

Next
    Next

Set fso = Nothing

MsgBox "Done saving attachments"
End With
End Sub

Function FileExist(FilePath As String) As Boolean

Dim TestStr As String
Debug.Print FilePath
On Error Resume Next
TestStr = Dir(FilePath)
On Error GoTo 0
'Determine if File exists
If TestStr = "" Then
    FileExist = False
Else
    FileExist = True
End If

End Function

Upvotes: 0

Views: 159

Answers (1)

Paul Ogilvie
Paul Ogilvie

Reputation: 25266

The logic is:

For Each obj In objItems
    With obj
        For Each objAtt In itm.Attachments

This must be "closed" in the reverse manner:

        Next objAtt
    End With
Next obj

Check this sequence in your code and adjust accordingly.

Note: although VB doesn't require (anymore) that a Next mentions its loop variable, it is good practice and helps you to better understand your For loops.

Upvotes: 3

Related Questions