Переименовать файлы по списку!?

[jungo]

У меня такой вопрос:

В папке лежат файлы.
В экселе есть список этих файлов.
Название у этих файлов ровны их порядковым номерам.
В экселе кроме порядковых номеров есть столбец с номером выпуска (1,2,3 или A,B,C).
А теперь вопрос:
Как можно переименовать все файлы в папке сразу так, чтобы получилась такая форма:
порядковый номер@номер выпуска.
например:
123546@1
Думаю получится полезная штучка для многих.

[SAS888]

Пусть в столбце "A" - имена файлов, в столбце "B" - то, что нужно добавить к имени соответствующих файлов.
1) Пропишите нужный путь к папке.
2) Имена файлов в столбце "A" должны содержать расширение.
3) Если нужно, вставьте проверку существования файла по заданному пути (в коде этого нет).

Sub RenameFiles()

    Dim OldName As String, NewName As String, MyPath As String, a
    
    MyPath = "D:\Temp\" ' Path to folder
    
    For i = 1 To Cells(Rows.Count, "A").End(xlUp).Row
        If Cells(i, "A") <> "" Then
            a = Split(Cells(i, "A"), ".")
            OldName = MyPath & Cells(i, "A")
            NewName = MyPath & a(LBound(a)) & "@" & Cells(i, "B") & "." & a(UBound(a))
            Name OldName As NewName    ' Rename file.
        End If
    Next

End Sub

Макрос работает с любыми типами файлов.

[jungo]

Сообщение от SAS888

Пусть в столбце "A" - имена файлов, в столбце "B" - то, что нужно добавить к имени соответствующих файлов.
1) Пропишите нужный путь к папке.
2) Имена файлов в столбце "A" должны содержать расширение.
3) Если нужно, вставьте проверку существования файла по заданному пути (в коде этого нет).
Макрос работает с любыми типами файлов.

Макрос не работает, показывает ошибку.
1. Сами значения работают (подвел мышку - на Nname и на Oname показывает правильные значения).
2. Название файлов у меня н 100 % точны.
3. Можно MyPath выбрать в процессе макроса?
Прикрепил рисунок.

[SAS888]

Посмотрите другой вариант.
1) По совету дмидми, используется объект FileSystemObject
2) Добавлено окно выбора рабочей папки.

ПОДКЛЮЧИТЕ в Tools -> References библиотеку Microsoft Scripting Runtime.

Sub RenameFiles()

    Dim fso As FileSystemObject, OldName As String, NewName As String
    Dim Ext As String, FilePath As String, Fn As String
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    With Application.FileDialog(msoFileDialogFolderPicker)
        .InitialFileName = "C:\"
        .Title = "Select folder"
        .Show
        If .SelectedItems.Count = 0 Then
            Exit Sub
        Else
            FilePath = .SelectedItems(1) & "\"
        End If
    End With
    
    For i = 1 To Cells(Rows.Count, "A").End(xlUp).Row
        If Cells(i, "A") <> "" Then
            OldName = FilePath & Cells(i, "A")
            Fn = fso.GetBaseName(OldName)
            Ext = fso.GetExtensionName(OldName)
            NewName = FilePath & Fn & "@" & Cells(i, "B") & "." & Ext
            Name OldName As NewName    ' Rename file.
        End If
    Next

End Sub

Хочу добавить, что макрос тестирован в Excel 2003

[jungo]

Получилось!!!

SAS888
Огромное спасибо!!!

Третий мой вопрос в силе.

[дмидми]

Сообщение от SAS888

Name OldName As NewName

Вспомним о нежно любимой клавише: nameF1

Сообщение от F1 для Excel VB Name Statement

The file name specified by newpathname can't already exist.

Лень проверять, но не исключено, что FileSystemObject переименовывает/перемещает во что бы то ни стало.

[IgorGO]

То же лень проверять.
Но не переименовывается.

[дмидми]

Слазил в хэлп для FileSystemObject.

Для Name случай, когда файл с таким именем уже существует, не документирован. Стало быть, требуется предварительное удаление.

Перемещение там отдельно, и при перемещении такой конфликт вызывает ошибку, которую при желании можно обработать.

[SAS888]

IgorGo. Ты не забыл подключить Microsoft Scripting Runtime?

дмидми. Я же оговорил, что

Если нужно, вставьте проверку существования файла по заданному пути (в коде этого нет).

Вот код с проверками: Если искомый файл существует, а конечного нет, только тогда переименовываем. Ну, или делаем то, что там автору темы нужно.

Sub RenameFiles()

    Dim fso As FileSystemObject, OldName As String, NewName As String
    Dim Ext As String, FilePath As String, Fn As String
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    With Application.FileDialog(msoFileDialogFolderPicker)
        .InitialFileName = "C:\"
        .Title = "Select folder"
        .Show
        If .SelectedItems.Count = 0 Then
            Exit Sub
        Else
            FilePath = .SelectedItems(1) & "\"
        End If
    End With
    
    For i = 1 To Cells(Rows.Count, "A").End(xlUp).Row
        If Cells(i, "A") <> "" Then
            OldName = FilePath & Cells(i, "A")
            Fn = fso.GetBaseName(OldName)
            Ext = fso.GetExtensionName(OldName)
            NewName = FilePath & Fn & "@" & Cells(i, "B") & "." & Ext
            
            If Dir(OldName) <> "" Then If Dir(NewName) = "" Then Name OldName As NewName
            
        End If
    Next

End Sub

jungo. Что значит

Третий мой вопрос в силе.

Я что-то не то предложил? Путь к рабочей папке запрашивается в ходе макроса. После указания рабочей папки - продолжение работы процедуры. Или что Вам нужно?

[jungo]

Сообщение от SAS888

jungo. Что значит Я что-то не то предложил? Путь к рабочей папке запрашивается в ходе макроса. После указания рабочей папки - продолжение работы процедуры. Или что Вам нужно?

Всё супер! Спасибо! Я пост написал до того как увидел твой ответ.

Единственный вопрос, так, для себя:

Окно для выбора папки открывается, но в нём не видно файлов лежащих в папке. Возможно ли сделать так, чтобы можно было видеть файлы (All Files). Пытаюсь предотвратить ошибки чайников (своих в том числе).