Copying files and changing names

[2022]

I have several files with a specific word in each of the file names - let’s say it’s “blue” but the rest of the text in the file names is different.

Is there a way to copy all of them and have exactly the same name but change “blue” to “orange” using vba?

To give a simple example, let’s say I had two files in a folder on my Desktop called “Blue”.

And within that folder called “Blue” I had two files called

NewBlue
OldBlue

Is there a way to copy those files but put them into a new folder called “Orange” on the Desktop and have the copies renamed to

OldOrange
NewOrange?

 

[DanteAmor]

Hi @2022, thanks for posting on the forum.


I provide you 3 versions.

In the first one it asks you for the keyword and the new word:

Sub CopyingFiles()
  Dim sPath As String, files As String
  Dim oldWord As Variant, newWord As Variant
  Dim newName As String
  
  oldWord = InputBox("Enter the current word", "COPY FILES")
  newWord = InputBox("Enter new word", "COPY FILES")
  If oldWord = "" Then Exit Sub
  If newWord = "" Then Exit Sub
  
  sPath = Environ("USERPROFILE") & "\Desktop\"
  If Dir(sPath & newWord, vbDirectory) = "" Then
    MkDir sPath & newWord
  End If
  files = Dir(sPath & "*" & oldWord & "*")
  Do While files <> ""
    newName = Replace(files, oldWord, newWord, , , vbTextCompare)
    FileCopy sPath & files, sPath & newWord & "\" & newName
    files = Dir()
  Loop
End Sub

In the second version you can provide the words in the code:

Sub CopyingFiles_v2()
  Dim sPath As String, files As String
  Dim oldWord As String, newWord As String
  Dim newName As String
  
  oldWord = "blue"      'Fit the old word
  newWord = "orange"    'Fit the new word
  
  sPath = Environ("USERPROFILE") & "\Desktop\"
  If Dir(sPath & newWord, vbDirectory) = "" Then
    MkDir sPath & newWord
  End If
  files = Dir(sPath & "*" & oldWord & "*")
  Do While files <> ""
    newName = Replace(files, oldWord, newWord, , , vbTextCompare)
    FileCopy sPath & files, sPath & newWord & "\" & newName
    files = Dir()
  Loop
End Sub

In the third option you can put the data in the cells of a sheet.

Sub CopyingFiles_v3()
  Dim sPath As String, files As String
  Dim oldWord As String, newWord As String
  Dim newName As String
  
  oldWord = Sheets("Sheet1").Range("A1").Value  'Fit the name of the sheet and cell.
  newWord = Sheets("Sheet1").Range("A2").Value  'Fit the name of the sheet and cell.
  
  sPath = Environ("USERPROFILE") & "\Desktop\"
  If Dir(sPath & newWord, vbDirectory) = "" Then
    MkDir sPath & newWord
  End If
  files = Dir(sPath & "*" & oldWord & "*")
  Do While files <> ""
    newName = Replace(files, oldWord, newWord, , , vbTextCompare)
    FileCopy sPath & files, sPath & newWord & "\" & newName
    files = Dir()
  Loop
End Sub

--------------
Let me know the result and I'll get back to you as soon as I can.
Sincerely
Dante Amor
--------------

 

[2022]

Awesome!!!

Thank you - I’ll test these out and get back to you!!

 

[2022]

Hmmm....I tried the second method, but it didn't work?

I added the Sub to an xlsm file and had two xlsx files saved on my desktop: "OldBlue" and "NewBlue" but the Sub didn't work?

Did I miss something?