Macro to rename all files in a folder

[DownUnderFar]

I'm looking for a macro to place on a button in a workbook. I'd like the macro to open all files (excel files) in a fixed folder (we'll say the local desktop for this example), and will:

1. Save the files with a new name, the value of cell A1 and "_A" If sell A1 = TKK, the new file name will be TKK_A
2. Delete the original file.

Thanks

 

[DownUnderFar]

Oh - one more thing. If the file name already ends with "_A,", don't rename it or delete it, just leave it as is.

(The idea behind this is files will be added to the folder throughout the day and I only want to rename the ones that weren't already renamed).

 

[Herakles]

I'm looking for a macro to place on a button in a workbook. I'd like the macro to open all files (excel files) in a fixed folder (we'll say the local desktop for this example), and will:

1. Save the files with a new name, the value of cell A1 and "_A" If sell A1 = TKK, the new file name will be TKK_A
2. Delete the original file.

Thanks

All files cannot be saved with the value in A1 and the TKK_A suffix.

I asume that you want to keep the same file extension.

 

[eiloken]

Oh - one more thing. If the file name already ends with "_A,", don't rename it or delete it, just leave it as is.

(The idea behind this is files will be added to the folder throughout the day and I only want to rename the ones that weren't already renamed).

i don't try it yet but think this will work:

Sub ListFilesInFolder()
    Dim xFolderName As String
    Dim xFSO As Object
    Dim xFolder As Object
    Dim xFile As Object
    Dim i As Integer
    Set folder = Application.FileDialog(msoFileDialogFolderPicker)
    If folder.Show <> -1 Then Exit Sub
    xFolderName = folder.SelectedItems(1)
    Set xFSO = CreateObject("Scripting.FileSystemObject")
    Set xFolder = xFSO.GetFolder(xFolderName)
    For Each xFile In xFolder.Files
        If Not xFSO.GetBaseName(xFile) Like "*_A" And xFSO.GetExtensioNname(xFile) Like "xls*" Then
            i = i + 1
            Name xFile.Path As xFSO.GetParentFolderName(xFile) & "\" & ThisWorkbook.Sheets(1).Cells(i, 1).Value & "_A." & xFSO.GetExtensioNname(xFile)
            xFSO.DeleteFile xFile.Path
        End If
    Next xFile
    Set xFile = Nothing
    Set xFolder = Nothing
    Set xFSO = Nothing
End Sub

 

[eiloken]

i don't try it yet but think this will work:

Sub ListFilesInFolder()
    Dim xFolderName As String
    Dim xFSO As Object
    Dim xFolder As Object
    Dim xFile As Object
    Dim i As Integer
    Set folder = Application.FileDialog(msoFileDialogFolderPicker)
    If folder.Show <> -1 Then Exit Sub
    xFolderName = folder.SelectedItems(1)
    Set xFSO = CreateObject("Scripting.FileSystemObject")
    Set xFolder = xFSO.GetFolder(xFolderName)
    For Each xFile In xFolder.Files
        If Not xFSO.GetBaseName(xFile) Like "*_A" And xFSO.GetExtensioNname(xFile) Like "xls*" Then
            i = i + 1
            Name xFile.Path As xFSO.GetParentFolderName(xFile) & "\" & ThisWorkbook.Sheets(1).Cells(i, 1).Value & "_A." & xFSO.GetExtensioNname(xFile)
            xFSO.DeleteFile xFile.Path
        End If
    Next xFile
    Set xFile = Nothing
    Set xFolder = Nothing
    Set xFSO = Nothing
End Sub

one more thing, i don't know why you need to be open all the files in folder but it your folder include too many files, it will risk your computer. Beside when you open file, you can not rename and delete it.

 

[DownUnderFar]

Yes. The same file extension.

I don't need them all to be open at once. The only reason to open them is to copy the value from cell A1 and save_as. My goal is to get all of the file names equal to [cellvalue]_a.xlsx, it doesn't matter how I get there. Whether it's a rename function or save as and delete the original function. There could be up to 150 files at once.

 

[eiloken]

Yes. The same file extension.

I don't need them all to be open at once. The only reason to open them is to copy the value from cell A1 and save_as. My goal is to get all of the file names equal to [cellvalue]_a.xlsx, it doesn't matter how I get there. Whether it's a rename function or save as and delete the original function. There could be up to 150 files at once.

Ok so i made some misunderstanding, you can using this code:

Sub RenameWorkbooks()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Dim xFolderName As String
    Dim xFSO As Object
    Dim xFolder As Object
    Dim xFile As Object
    Dim FilePath As String
    Dim FolderPath As String
    Dim FileName As String
    Dim FileExt As String
    Dim NewName As String
    Dim wb As Workbook
    Set folder = Application.FileDialog(msoFileDialogFolderPicker) 'pick parent folder
    If folder.Show <> -1 Then Exit Sub
    xFolderName = folder.SelectedItems(1)
    Set xFSO = CreateObject("Scripting.FileSystemObject")
    Set xFolder = xFSO.GetFolder(xFolderName)
    For Each xFile In xFolder.Files 'loop through files in folder
        FilePath = xFSO.GetAbsolutePathName(xFile)
        FolderPath = xFSO.GetParentFolderName(xFile)
        FileName = xFSO.GetBaseName(xFile)
        FileExt = xFSO.GetExtensioNname(xFile)
        If Not FileName Like "*_A" And FileExt Like "xls*" Then 'condition when filename not include _A and file is excel file
            Set wb = Workbooks.Open(FilePath)
            NewName = FolderPath & "\" & wb.Sheets(1).Cells(1, 1).Value & "_A." & FileExt 'get value in cell A1 of sheet1 and set it to newname of workbook
            wb.Close (False)
            Name FilePath As NewName
        End If
    Next xFile
    Set xFile = Nothing
    Set xFolder = Nothing
    Set xFSO = Nothing
    MsgBox "All done"
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub