Renaming Photos in a folder without replacing

[pmich]

I have Photos in a folder. All the Photos begin with a number. Then after a space a caption is given. I wish to rename the photos only with the numbers.
Example of file names : 312 Hotel, 456 Park, 634 Car.
But some photos were given same numbers with different captions. 456 Bike.
So, while I rename, I check whether a file with the same number is already there in the folder and then do not replace the existing photo.
But after checking for existence of a photo with the same number, if there is duplication, the code stops at [MyOldFile = Dir] with the error mesage 'invalid procedure call or arguement'
If there is duplication, the code should check other photos. How am I to make the code run? Kindly suggest.
This is the code I have:

Private Sub RenamePhotosDontReplace()
Dim MyFolder As String
Dim MyOldFile As String
Dim MyFile As String
MyFolder = "D:\FotoRenaming\"
MyOldFile = Dir(MyFolder & "*.jpg")
MyFile = MyOldFile

Do While MyFile <> ""
MyFile = Mid(MyFile, 1, InStr(MyFile, " ") - 1)
 If Not Dir(MyFolder & MyFile, vbDirectory) = vbNullString Then
  MsgBox "File [" & MyFile & "] already exists"
 Else
  MsgBox "File [" & MyFile & "] does not exist"
  Name MyFolder & MyOldFile As MyFolder & MyFile & ".jpg"
 End If
 MyOldFile = Dir
 MyFile = MyOldFile
Loop
End Sub

 

[Anthony47]

You cannot use Dir to check if a file already exists and to get the "next" available file.

Help for the Dir function (see Dir function (Visual Basic for Applications)) says:
Dir returns the first file name that matches pathname. To get any additional file names that match pathname, call Dir again with no arguments. When no more file names match, Dir returns a zero-length string (""). After a zero-length string is returned, you must specify pathname in subsequent calls, or an error occurs

You can avoid the conflict by using the Scripting.FileSystemObject library to check if file exists.

So, your macro could became:

Private Sub RenamePhotosDontReplace22()
Dim MyFolder As String
Dim MyOldFile As String
Dim MyFile As String
MyFolder = "D:\FotoRenaming\"
MyOldFile = Dir(MyFolder & "*.jpg")
MyFile = MyOldFile

Dim FSO As Object          '+++

Set FSO = CreateObject("Scripting.FileSystemObject")    '+++
Do While MyFile <> ""
If InStr(1, MyFile, " ", vbTextCompare) > 1 Then        '+++ Added If
    MyFile = Mid(MyFile, 1, InStr(MyFile, " ") - 1)     '*** Modified
    If Not FSO.fileExists(MyFolder & MyFile) Then
        MsgBox "File [" & MyFile & "] already exists"
    Else
        MsgBox "File [" & MyFile & "] does not exist"
        Name MyFolder & MyOldFile As MyFolder & MyFile & ".jpg"
    End If
End If
MyOldFile = Dir
MyFile = MyOldFile
Loop
MsgBox ("Completed...")
Set FSO = Nothing
End Sub

Added lines are marked +++, and *** the modified one
There is an added IF, to avoid error in case the file name don't contain any "space"

If you would like to use an "Extension" in case a file name already exists (for example: 456 Car.jpg become 456.jpg; 456 Bike.jpg become 456_1.jpg) then you could use the following variant:

Private Sub RenamePhotosDontReplace33()
Dim MyFolder As String
Dim MyOldFile As String
Dim MyFile As String
MyFolder = "D:\FotoRenaming\"
MyOldFile = Dir(MyFolder & "*.jpg")
MyFile = MyOldFile

Dim FSO As Object, Good As Boolean, fCnt As Long

Set FSO = CreateObject("Scripting.FileSystemObject")
Do While MyFile <> ""
If InStr(1, MyFile, " ", vbTextCompare) > 1 Then        '+++ Added If
    MyFile = Mid(MyFile, 1, InStr(MyFile, " ") - 1)
    If Not FSO.fileExists(MyFolder & MyFile) Then
        MsgBox "File [" & MyFile & "] already exists"
        Do
            fCnt = fCnt + 1
            If Not FSO.fileExists(MyFolder & MyFile & "_" & fCnt & ".jpg") Then
                Name MyFolder & MyOldFile As MyFolder & MyFile & "_" & fCnt & ".jpg"
                Exit Do
            End If
            If fCnt > 500 Then
                'prevents deadlock:
                MsgBox ("Rename failed for file " & MyOldFile)
                Exit Do
            End If
        Loop
    Else
    '  MsgBox "File [" & MyFile & "] does not exist"
        Name MyFolder & MyOldFile As MyFolder & MyFile & ".jpg"
    End If
    fCnt = 0
End If
MyOldFile = Dir
MyFile = MyOldFile
Loop
MsgBox ("Completed...")
Set FSO = Nothing
End Sub

Bye

 

[pmich]

@Anthony47
Thanks.
I slightly modified as given below:

If Not FSO.fileExists(MyFolder & MyFile & ".jpg") Then
        MsgBox "File [" & MyFile & "] does not exist"
        Name MyFolder & MyOldFile As MyFolder & MyFile & ".jpg"
    Else
        MsgBox "File [" & MyFile & "] already exists"
    End If

It works fine.

 

[pmich]

@Anthony47
Thanks for the code with fCnt.
I modified this as in the code below:

        If fCnt > 2 Then
            'prevents deadlock:
                MsgBox ("Rename failed for file " & MyOldFile)
                Exit Do
            Else 'fCnt > 2
            If Not FSO.fileExists(MyFolder & MyFile & "_" & fCnt & ".jpg") Then
                Name MyFolder & MyOldFile As MyFolder & MyFile & "_" & fCnt & ".jpg"
                Exit Do
            End If 'Not FSO.fileExists(MyFolder & MyFile & "_" & fCnt & ".jpg")
            End If 'fCnt > 2

It is working fine. Thanks for this deadlock.