none
On error not working with scripting object RRS feed

  • Question

  • I have a load of image filenames I need to change, the original and new names contained in a worksheet.  While there are better ways of controling the error I'm trapping here, there are only about 5 or 6 instances that won't rename (a file of that name already exists) and it's likely a one off process, so I just thought it would be easier to make those few changes manually.  However, my On Error doesn't seem to work as I still get the runtime error 58 'File already exists'.  I've pasted the code below and would appreciate any input so I can get a better understanding of what I've got wrong.

    Sub ChangeFileNames()

    Dim FSO As Scripting.FileSystemObject
    Dim sourceFolder As Scripting.Folder
    Dim fileItem As Scripting.File
    Dim imageName As String
    Dim newImageName As String
    Dim lastRow As Integer
    Dim i As Integer
    Dim i2 As Integer
                       
    Worksheets("Sheet2").Activate
    lastRow = ActiveSheet.UsedRange.Rows.Count
    i2 = 1

    Set FSO = New Scripting.FileSystemObject
    Set sourceFolder = FSO.GetFolder("C:\Users\Richard\Desktop\USImages\UploadFile")
    For Each fileItem In sourceFolder.Files
        imageName = fileItem.Name
        For i = 4 To lastRow
            On Error GoTo errHandler
            If Worksheets("Sheet2").Range("A" & i) = imageName Or LCase(Worksheets("Sheet2").Range("A" & i)) = imageName Then
                If Worksheets("Sheet2").Range("I" & i) = "" Then
                    Name fileItem As "C:\Users\Richard\Desktop\USImages\DeletedImages\" & fileItem.Name
                    'Kill (fileItem)
                    Exit For
                Else
                    If Worksheets("Sheet2").Range("I" & i) <> imageName Then
                        newImageName = Worksheets("Sheet2").Range("I" & i)
                        Name fileItem As "C:\Users\Richard\Desktop\USImages\UploadFile\" & newImageName & ".jpg"
                        Exit For
                    End If
                End If
            End If
        Next i
    Next fileItem
                   
    Exit Sub
    errHandler:
    If Err = 58 Then
        Worksheets("Sheet3").Range("A" & i2) = fileItem.Path & fileItem.Name
        i2 = i2 + 1
        Resume Next
    End If
                   
    End Sub

    Monday, November 7, 2011 10:26 AM

Answers

  • In a light test your error handler seemed to work as expected for me.

    Look at Tools, Options, General, Error trapping and ensure you've got "Break on unhandled errors ticked"

    In passing, fileItem.Path returns in path + filename, to return only the Path use fileItem.ParentFolder.Path

    Peter Thornton

    Monday, November 7, 2011 11:14 AM
    Moderator

All replies

  • In a light test your error handler seemed to work as expected for me.

    Look at Tools, Options, General, Error trapping and ensure you've got "Break on unhandled errors ticked"

    In passing, fileItem.Path returns in path + filename, to return only the Path use fileItem.ParentFolder.Path

    Peter Thornton

    Monday, November 7, 2011 11:14 AM
    Moderator
  • Brilliant, thanks Peter.  I'd forgotten about that setting.  It was set to break on all errors.  Changed it and problem now solved. :)
    Monday, November 7, 2011 3:22 PM