Solved Rename and Move Files to a Folder in Bulk (1 Viewer)

jack555

Member
Local time
Tomorrow, 03:40
Joined
Apr 20, 2020
Messages
93
it will rename the files Again and Again, let me explain.

supposed there is a filename: x.txt
you run the function to rename it with prefix "1_"
the function will check if "1_x.txt" (prefix of "1_" + the filename) already exists.
it will not find, so it will be renamed as "1_x.txt"

you run the function again using same prefix of "1_"
the functon will check if "1_1_x.txt" exists, (remember that
we already renamed x.txt as 1_x.txt, adding another prefix of "1_",
we are now to look if prefix & filename, exists which is "1_" & "1_x.txt")
it will not find, so again it will rename it.
so, means it's not possible to exclude the items already with prefix. better to leave this condition?
 

arnelgp

..forever waiting... waiting for jellybean!
Local time
Tomorrow, 07:40
Joined
May 7, 2009
Messages
19,169
i added another parameter (secondRename).
you pass True to this parameter, so it will strip the
"prefix/suffix" we put on the first rename.
then compare it.

to call it (without adding suffix):

fncRenameFiles "d:\folder", , , "yourPrefix", "", True
Code:
Public Function fncRenameFiles(ByVal theSourcePath As String, _
                        Optional ByVal theFile As String = "*", _
                        Optional ByVal theExtension As String = "*", _
                        Optional ByVal prefix As String = "", _
                        Optional ByVal suffix As String = "", _
                        Optional ByVal secondRename As Boolean = False)
' Note:
'
' not much validation on this function, so:
'
' don't add extension (.bat, .xlsx, etc) to "theFile"
' don't ad "." to the "theExtension (simply "bat" or "xlsx")
'
' theSourcePath must be valid path
'
' make sure none of the Files to be renamed are opened
' by another program.
'
Dim sFile As String
Dim col As New Collection
Dim i As Integer
Dim sName As String, sExt As String
Dim bolOK As Boolean
' if nothing to do exit sub
If Len(prefix) = 0 And Len(suffix) = 0 Then
      Exit Function
End If
If Right$(theSourcePath, 1) <> "\" Then
    theSourcePath = theSourcePath & "\"
End If
sFile = Dir$(theSourcePath & theFile & theExtension)
'put all files in collection
Do Until Len(sFile) = 0
      col.Add sFile
      sFile = Dir$
Loop
'rename files in collection
For i = 1 To col.Count
      sName = Replace$(thisFileName(col(i)), theSourcePath, vbNullString)
      sExt = thisExtension(col(i))
      'Debug.Print col(i), theSourcePath & prefix & sName & suffix & "." & sExt
      '
      'agp
      '25-aug-2021
      'do not rename if already exists
      '
      If secondRename Then
        sName = Mid$(sName, Len(prefix) + 1)
        If Len(suffix) <> 0 Then
            sName = Left$(sName, Len(sName) - Len(suffix))
        End If
      End If
      bolOK = Len(Dir$(theSourcePath & prefix & sName & suffix & "." & sExt)) = 0
      If bolOK Then
         Name theSourcePath & col(i) As (theSourcePath & prefix & sName & suffix & "." & sExt)
      End If
Next
'Msgbox "Done Renaming."
End Function


Private Function thisFileName(ByVal pFile) As String
    Dim i As Integer
    thisFileName = pFile
    i = InStrRev(pFile, ".")
    If i > 0 Then
        thisFileName = Left(pFile, i - 1)
    End If
End Function

Private Function thisExtension(ByVal pFile) As String
    Dim i As Integer
    thisExtension = pFile
    i = InStrRev(pFile, ".")
    If i > 0 Then
        thisExtension = Mid(pFile, i + 1)
    End If
End Function
 

jack555

Member
Local time
Tomorrow, 03:40
Joined
Apr 20, 2020
Messages
93
i added another parameter (secondRename).
you pass True to this parameter, so it will strip the
"prefix/suffix" we put on the first rename.
then compare it.

to call it (without adding suffix):

fncRenameFiles "d:\folder", , , "yourPrefix", "", True
Code:
Public Function fncRenameFiles(ByVal theSourcePath As String, _
                        Optional ByVal theFile As String = "*", _
                        Optional ByVal theExtension As String = "*", _
                        Optional ByVal prefix As String = "", _
                        Optional ByVal suffix As String = "", _
                        Optional ByVal secondRename As Boolean = False)
' Note:
'
' not much validation on this function, so:
'
' don't add extension (.bat, .xlsx, etc) to "theFile"
' don't ad "." to the "theExtension (simply "bat" or "xlsx")
'
' theSourcePath must be valid path
'
' make sure none of the Files to be renamed are opened
' by another program.
'
Dim sFile As String
Dim col As New Collection
Dim i As Integer
Dim sName As String, sExt As String
Dim bolOK As Boolean
' if nothing to do exit sub
If Len(prefix) = 0 And Len(suffix) = 0 Then
      Exit Function
End If
If Right$(theSourcePath, 1) <> "\" Then
    theSourcePath = theSourcePath & "\"
End If
sFile = Dir$(theSourcePath & theFile & theExtension)
'put all files in collection
Do Until Len(sFile) = 0
      col.Add sFile
      sFile = Dir$
Loop
'rename files in collection
For i = 1 To col.Count
      sName = Replace$(thisFileName(col(i)), theSourcePath, vbNullString)
      sExt = thisExtension(col(i))
      'Debug.Print col(i), theSourcePath & prefix & sName & suffix & "." & sExt
      '
      'agp
      '25-aug-2021
      'do not rename if already exists
      '
      If secondRename Then
        sName = Mid$(sName, Len(prefix) + 1)
        If Len(suffix) <> 0 Then
            sName = Left$(sName, Len(sName) - Len(suffix))
        End If
      End If
      bolOK = Len(Dir$(theSourcePath & prefix & sName & suffix & "." & sExt)) = 0
      If bolOK Then
         Name theSourcePath & col(i) As (theSourcePath & prefix & sName & suffix & "." & sExt)
      End If
Next
'Msgbox "Done Renaming."
End Function


Private Function thisFileName(ByVal pFile) As String
    Dim i As Integer
    thisFileName = pFile
    i = InStrRev(pFile, ".")
    If i > 0 Then
        thisFileName = Left(pFile, i - 1)
    End If
End Function

Private Function thisExtension(ByVal pFile) As String
    Dim i As Integer
    thisExtension = pFile
    i = InStrRev(pFile, ".")
    If i > 0 Then
        thisExtension = Mid(pFile, i + 1)
    End If
End Function

It works the intended way. However, strips some of the characters in the first part of the file after renaming which had no prefix. In the below example, characters "test file" stripped for the file which didn't have the prefix.

Before:
1629965068440.png


After:
1629965125657.png
 

arnelgp

..forever waiting... waiting for jellybean!
Local time
Tomorrow, 07:40
Joined
May 7, 2009
Messages
19,169
here check and test again.
Code:
Public Function fncRenameFiles(ByVal theSourcePath As String, _
                        Optional ByVal theFile As String = "*", _
                        Optional ByVal theExtension As String = "*", _
                        Optional ByVal prefix As String = "", _
                        Optional ByVal suffix As String = "", _
                        Optional ByVal secondRename As Boolean = False)
' Note:
'
' not much validation on this function, so:
'
' don't add extension (.bat, .xlsx, etc) to "theFile"
' don't ad "." to the "theExtension (simply "bat" or "xlsx")
'
' theSourcePath must be valid path
'
' make sure none of the Files to be renamed are opened
' by another program.
'
Dim sFile As String
Dim col As New Collection
Dim i As Integer
Dim sName As String, sExt As String
Dim bolOK As Boolean, sTemp As String
' if nothing to do exit sub
If Len(prefix) = 0 And Len(suffix) = 0 Then
      Exit Function
End If
If Right$(theSourcePath, 1) <> "\" Then
    theSourcePath = theSourcePath & "\"
End If
sFile = Dir$(theSourcePath & theFile & theExtension)
'put all files in collection
Do Until Len(sFile) = 0
      col.Add sFile
      sFile = Dir$
Loop
'rename files in collection
For i = 1 To col.Count
      sName = Replace$(thisFileName(col(i)), theSourcePath, vbNullString)
      sExt = thisExtension(col(i))
      'Debug.Print col(i), theSourcePath & prefix & sName & suffix & "." & sExt
      '
      'agp
      '25-aug-2021
      'do not rename if already exists
      '
      sTemp = sName
      If secondRename Then
        sTemp = Mid$(sTemp, Len(prefix) + 1)
        If Len(suffix) <> 0 Then
            sTemp = Left$(sTemp, Len(sTemp) - Len(suffix))
        End If
      End If
      bolOK = Len(Dir$(theSourcePath & prefix & sTemp & suffix & "." & sExt)) = 0
      If bolOK Then
         Name theSourcePath & col(i) As (theSourcePath & prefix & sName & suffix & "." & sExt)
      End If
Next
'Msgbox "Done Renaming."
End Function
 

jack555

Member
Local time
Tomorrow, 03:40
Joined
Apr 20, 2020
Messages
93
here check and test again.
Code:
Public Function fncRenameFiles(ByVal theSourcePath As String, _
                        Optional ByVal theFile As String = "*", _
                        Optional ByVal theExtension As String = "*", _
                        Optional ByVal prefix As String = "", _
                        Optional ByVal suffix As String = "", _
                        Optional ByVal secondRename As Boolean = False)
' Note:
'
' not much validation on this function, so:
'
' don't add extension (.bat, .xlsx, etc) to "theFile"
' don't ad "." to the "theExtension (simply "bat" or "xlsx")
'
' theSourcePath must be valid path
'
' make sure none of the Files to be renamed are opened
' by another program.
'
Dim sFile As String
Dim col As New Collection
Dim i As Integer
Dim sName As String, sExt As String
Dim bolOK As Boolean, sTemp As String
' if nothing to do exit sub
If Len(prefix) = 0 And Len(suffix) = 0 Then
      Exit Function
End If
If Right$(theSourcePath, 1) <> "\" Then
    theSourcePath = theSourcePath & "\"
End If
sFile = Dir$(theSourcePath & theFile & theExtension)
'put all files in collection
Do Until Len(sFile) = 0
      col.Add sFile
      sFile = Dir$
Loop
'rename files in collection
For i = 1 To col.Count
      sName = Replace$(thisFileName(col(i)), theSourcePath, vbNullString)
      sExt = thisExtension(col(i))
      'Debug.Print col(i), theSourcePath & prefix & sName & suffix & "." & sExt
      '
      'agp
      '25-aug-2021
      'do not rename if already exists
      '
      sTemp = sName
      If secondRename Then
        sTemp = Mid$(sTemp, Len(prefix) + 1)
        If Len(suffix) <> 0 Then
            sTemp = Left$(sTemp, Len(sTemp) - Len(suffix))
        End If
      End If
      bolOK = Len(Dir$(theSourcePath & prefix & sTemp & suffix & "." & sExt)) = 0
      If bolOK Then
         Name theSourcePath & col(i) As (theSourcePath & prefix & sName & suffix & "." & sExt)
      End If
Next
'Msgbox "Done Renaming."
End Function
It worked like a magic wand. Thank you for helping. You are a star.
 

Users who are viewing this thread

Top Bottom