Renaming all files in a folder (there is a mix of .txt and .xlsx)

[jmcginley3]

I have this macro which is the second half of my process to 1) pull in all the names of the files in a user selected folder and display them in column A and then 2) rename all those files to whatever the user inputs in column B on the spreadsheet. My problem is there are both .txt and .xlsx file types in the folder. I'm not sure how to account for the .txt files and make sure they remain .txt and aren't renamed to .xlsx. I know I'll need to make some sort of modification to the & ".xslx" portion or include some kind of If statement maybe? I'm pretty new to VBA, so any help would be greatly appreciated!

[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD]Current File Name Pulled into Spreadsheet using a different macro.[/TD]
[TD]Updated File Name the user types into the spreadsheet prior to running the second macro (the macro I've pasted below)[/TD]
[TD]What the desired result should be.[/TD]
[/TR]
[TR]
[TD]PartNumbers858fm_47838_fmf.TXT[/TD]
[TD]PartNumbers_08292018[/TD]
[TD]<-- When I run the macro, this should save this file name and retain the .TXT extension (instead of adding a .XLSX extension)[/TD]
[/TR]
[TR]
[TD]StoreNumbers583_573fm_3j.XLSX[/TD]
[TD]StoreNumber_08292018[/TD]
[TD]<-- When I run the macro, this should save this file name and retain the .XLSX extension (this is currently working with the macro)[/TD]
[/TR]
</tbody>[/TABLE]

Sub renamefiles()


Dim myPath As String
Dim myFile As String
Dim myExtension As String
Dim FldrPicker As FileDialog


'USER SELECTS LOCATION TO SAVE RENAMED FILES
 MsgBox "Select the location to save the renamed files."
  Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)
    With FldrPicker
      .Title = "Select A Folder"
      .AllowMultiSelect = False
        If .Show <> -1 Then GoTo NextCode
        myPath = .SelectedItems(1) & "\"
    End With


'USER CANCELS MESSAGE BOX
NextCode:
  myPath = myPath
  If myPath = "" Then GoTo ResetSettings


'RENAME FILES TO THE VALUES IN COLUMN B
r = 2
Do Until IsEmpty(Cells(r, 1)) And IsEmpty(Cells(r, 2))
Name myPath & Cells(r, 1).Value As myPath & Cells(r, 2).Value & ".xlsx"
r = r + 1
Loop


'PROCESS COMPLETE
MsgBox "Done."


ResetSettings:
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    
End Sub

 

[Fluff]

Try

Sub renamefiles()


Dim myPath As String
Dim myFile As String
Dim myExtension As String
Dim FldrPicker As fileDialog
Dim Onme As String, Nnme As String

'USER SELECTS LOCATION TO SAVE RENAMED FILES
 MsgBox "Select the location to save the renamed files."
  Set FldrPicker = Application.fileDialog(msoFileDialogFolderPicker)
    With FldrPicker
      .Title = "Select A Folder"
      .AllowMultiSelect = False
        If .Show <> -1 Then GoTo NextCode
        myPath = .SelectedItems(1) & "\"
    End With


'USER CANCELS MESSAGE BOX
NextCode:
  myPath = myPath
  If myPath = "" Then GoTo ResetSettings


'RENAME FILES TO THE VALUES IN COLUMN B
r = 2
Do Until IsEmpty(Cells(r, 1)) And IsEmpty(Cells(r, 2))
Onme = Cells(r, 1).Value
NwNme = Cells(r, 2).Value & Right(Onme, InStr(1, Onme, "."))
Name myPath & Cells(r, 1).Value As myPath & Cells(r, 2).Value & ".xlsx"
r = r + 1
Loop


'PROCESS COMPLETE
MsgBox "Done."


ResetSettings:
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    
End Sub

 

[jmcginley3]

Thank you very much for the reply. Unfortunately, that didn't seem to work. I noticed it had "Nnme As String" and then later it called for "NwNme" so after it didn't work the first time I tried changing these to match, but it still didn't work. It's changing all of the .txt files to .xlsx still. I tried one final thing and I removed the part where it has & ".xlsx" and then used your code, but then it just saves it as a generic file with no file type.

Any idea on what to try next?

 

[Fluff]

It would help if I had finished the code before posting
Try

Do Until IsEmpty(Cells(r, 1)) And IsEmpty(Cells(r, 2))
Onme = Cells(r, 1).Value
Nnme = Cells(r, 2).Value & Right(Onme, InStr(1, Onme, "."))
Name myPath & Onme As myPath & Nnme
r = r + 1
Loop

 

[jmcginley3]

Awesome, thank you! It is now retaining the correct file extension! The issue now though is it looks like it's changing the file name to be a combination of both the old file name and new file name. It's putting the contents of column B (the new file name) and then combining that with the contents of column A -- instead of just changing it to be the contents of column B only. Sorry if that's confusing lol.

 

[Fluff]

How about

Nnme = Cells(r, 2).Value & Right(Onme, Len(Onme) - InStr(1, Onme, ".") + 1)

 

[jmcginley3]

You rock! It works perfect now! Thanks so much for your help on this. It's going to save a TON of time renaming files.

 

[Fluff]

Glad to help & thanks for the feedback