Renaming Photos in a folder without replacing

pmich

Active Member
Joined
Jun 25, 2013
Messages
289
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:
Code:
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
 

Some videos you may like

Excel Facts

Did you know Excel offers Filter by Selection?
Add the AutoFilter icon to the Quick Access Toolbar. Select a cell containing Apple, click AutoFilter, and you will get all rows with Apple

Anthony47

Well-known Member
Joined
Mar 29, 2006
Messages
2,135
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:
Code:
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:
Code:
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

Active Member
Joined
Jun 25, 2013
Messages
289
@Anthony47
Thanks.
I slightly modified as given below:
Code:
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

Active Member
Joined
Jun 25, 2013
Messages
289
@Anthony47
Thanks for the code with fCnt.
I modified this as in the code below:
Code:
        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.
 

Watch MrExcel Video

Forum statistics

Threads
1,126,928
Messages
5,621,635
Members
415,849
Latest member
PhoenixRising2015

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top