Как упорядочить виртуальный файловый архив

[jungo]

Привет всем!

Очередной раз интересная и полезная заморочка

Нужен макрос который выполняет поочередно 4 шага.

1. Выбор папки с файлами (можно отметить *.* а можно конкретный формат .pdf) Макрос выдает в первом столбце Линки к каждому файлу, во втором только название файла.
2. Возможность переименовать файлы: В первом столбце уже есть линк во втором желаемое название файла.
3. Создать папки: Выбор папки в которой нужно создать папки. В одном из столбцов записаны название папок, которые нужно создать.
4. Масивный перенос файлов. В первом столбце есть линк к файлам. во втором название файлом. а в третем линк куда перенести каждый из файлов.

Все было в 2003 а в 2007 не работает!

[Казанский]

И где то, что работает в 2003? Или предлагается заново писать?

[Hugo121]

FileSearch заменить нужно?

[EducatedFool]

Для выбора файлов используйте эту функцию - и проблем не будет.
(хотя, судя по описанию, её вы и используете)

Что именно не работает?

[jungo]

К сожелению мой комп не рубит на русском...
У меня ничего не работает... ПОМОГИТЕ ЛЮДИ ДОБРЫЕ!!!

[jungo]

Привет!

Нашел на Англиском, только мне нужно что бы макрос глубже копал... заходил в под-деректории... ПОМОГИТЕ!

Option Explicit

Sub GetFileNames()

    Dim xRow As Long
    Dim xDirect$, xFname$, InitialFoldr$

    InitialFoldr$ = "G:\"    '<<< Startup folder to begin searching from

    With Application.FileDialog(msoFileDialogFolderPicker)
        .InitialFileName = Application.DefaultFilePath & "\"
        .Title = "Please select a folder to list Files from"
        .InitialFileName = InitialFoldr$
        .Show
        If .SelectedItems.Count <> 0 Then
            xDirect$ = .SelectedItems(1) & "\"
            xFname$ = Dir(xDirect$, 7)
            Do While xFname$ <> ""
                ActiveCell.Offset(xRow) = xFname$
                xRow = xRow + 1
                xFname$ = Dir
            Loop
         End If
    End With
End Sub

[doober]

Здесь только два слова по русски,замените и копайте вглубь