переименование файлов в разных папках

[Jaroslav]

Добрый день. У меня такая проблема: в разных папках (например, D:\data\1\, D:\data\2\ и так далее) одной папки (например, D:\data) есть файлы с расширением .xls с разными именами (в каждой папке по 1 файлу). Мне нужно переименовать их всех, чтобы у них было одно имя, например, НДС.xls.

[Puffi.Muffi]

Здравствуйте, Jaroslav,

Если вы знаете количество папок (например, 12 папок):
___________________________________ _______________________________

Sub pereim_faili()
Dim FfF
For FfF = 1 To 12

Dim sFileName As String, sNewFileName As String
 
    sFileName = "D:\data\" & FfF & "\имяфайла.xls"    'имя исходного файла
    sNewFileName = "D:\data\" & FfF & "\НДС.xls"    'новое имя файла
    Name sFileName As sNewFileName 'переименовываем файл

Next FfF
End Sub

___________________________________ ________________________________


Если хотите чтобы автоматически определялось:
*********************************** ************************

Private Sub Command1_Click()
'запускаем этот макрос

    Dim strStartPath As String
    strStartPath = "D:\data\" 
    ListFolder strStartPath
End Sub
 
Private Sub ListFolder(sFolderPath As String)
    Dim FS As New FileSystemObject
    Dim FSfolder As Folder
    Dim subfolder As Folder
    Dim i As Integer
    
    Set FSfolder = FS.GetFolder(sFolderPath)
 
    For Each subfolder In FSfolder.SubFolders
        DoEvents
        i = i + 1
        Debug.Print subfolder
    Next subfolder
    Set FSfolder = Nothing 
    
Dim FfF
For FfF = 1 To i

Dim sFileName As String, sNewFileName As String
    sFileName = "D:\data\" & FfF & "\имяфайла.xls"    'имя исходного файла
    sNewFileName = "D:\data\" & FfF & "\НДС.xls"    'новое имя файла
    Name sFileName As sNewFileName 'переименовываем файл
Next FfF
End Sub

*********************************** ************************
Чтобы последнее работало, не забудьте включить reference "Microsoft Scripting Runtime"
В редакторе VBA Tools -> Reference -> галочку на "Microsoft Scripting Runtime"




___________
Код нужно оформлять по правилам:
тегом [CODE]..[/СODE]
(кнопочка на панели форматирования с решёточкой #)
Не забывайте об этом!

Модератор.

[Jaroslav]

Здравствуйте, Puffi.Muffi. Дело в том, что название папок имеют нечисловые значения (D:\data\D018035\; D:\data\D017015\; D:\data\D015010\ и так далее). Числовые названия папок я подавал как пример (если неправильно написал, извините). Кроме того, имена файлов с расширением .xls разные (D:\data\D018035\НДС.xls; D:\data\D017015\деклар.xls; D:\data\D015010\декл_НДС.xls и так далее: все имена файлов с расширением .xls разные). Количесто папок - более 100.

[Jaroslav]

Вот что у меня получилось:

Private Sub Command1_Click()
'запускаем этот макрос

    Dim strStartPath As String
    strStartPath = "D:\data\"
    ListFolder strStartPath
End Sub
 
Private Sub ListFolder(sFolderPath As String)
    Dim FS As New FileSystemObject
    Dim FSfolder As Folder
    Dim subfolder As Folder
    Dim sFileName As String, sNewFileName As String
    Dim s As String
    Dim fls As Files
    Dim f As File


    Set FSfolder = FS.GetFolder(sFolderPath)
 
    For Each subfolder In FSfolder.SubFolders
        DoEvents
        Set fls = subfolder.Files
        For Each f In fls
            s = f.Name
            sFileName = subfolder & "\" & s    'имя исходного файла
            sNewFileName = subfolder & "\НДС.xls"    'новое имя файла
            Name sFileName As sNewFileName 'переименовываем файл
        Next f
    Next subfolder
    Set FSfolder = Nothing
End Sub

Спасибо, Puffi.Muffi. Проблема решена