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

jmcginley3

New Member
Joined
Mar 28, 2018
Messages
14
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!

Current File Name Pulled into Spreadsheet using a different macro.Updated File Name the user types into the spreadsheet prior to running the second macro (the macro I've pasted below)What the desired result should be.
PartNumbers858fm_47838_fmf.TXTPartNumbers_08292018<-- When I run the macro, this should save this file name and retain the .TXT extension (instead of adding a .XLSX extension)
StoreNumbers583_573fm_3j.XLSXStoreNumber_08292018<-- When I run the macro, this should save this file name and retain the .XLSX extension (this is currently working with the macro)

<tbody>
</tbody>



Code:
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
 

Excel Facts

How to find 2nd largest value in a column?
MAX finds the largest value. =LARGE(A:A,2) will find the second largest. =SMALL(A:A,3) will find the third smallest
Try
Code:
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
 
Upvote 0
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?
 
Upvote 0
It would help if I had finished the code before posting :oops:
Try
Code:
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
 
Last edited:
Upvote 0
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.
 
Upvote 0
How about
Code:
Nnme = Cells(r, 2).Value & Right(Onme, Len(Onme) - InStr(1, Onme, ".") + 1)
 
Upvote 0
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.
 
Upvote 0
Glad to help & thanks for the feedback
 
Upvote 0

Forum statistics

Threads
1,214,915
Messages
6,122,212
Members
449,074
Latest member
cancansova

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
Back
Top