[CDR X5-X8] Импорт файлов из нескольких папок в VBA

[Erchizo]

Добрый день!
Снова я к вам за помощью.
Задача: импортировать множество файлов "*.cdr" из разных папок.
Проблема: Не знаю с чего начать.))) Из хелпа понял только что необходимо воспользоваться функцией CorelScriptTools.GetFolder
Как его запустить? Как установить глубину поиска 1 уровень? И как это связать с уже готовым макросом?
Заранее благодарю.

 

[splxgf]

что значит глубину поиска в 1 уровень? без вложенных папок?
Корела нет под рукой, но универсальные варианты через fso должны работать
Excel 2010: VBA replacement for Application.FileSearch
VBA Express : Word - Process All Documents in a Specified Directory Folder Including Subfolders

 

[Erchizo]

что значит глубину поиска в 1 уровень? без вложенных папок?

Постараюсь объяснить мою "глубину в 1 уровень". Указываю для поиска "Темп", в котором есть еще папки:
...Темп->1234->0025
...Темп->1235
...Темп->1236->0028
Нужно брать файлы только в папках 1234, 1235, 1236..... , из 0025, 0028 не брать.

 

[Erchizo]

Excel 2010: VBA replacement for Application.FileSearch
VBA Express : Word - Process All Documents in a Specified Directory Folder Including Subfolders

К сожалению в VBA я не так давно так что ваша ссылка лично мне не помогла (((
Все равно спасибо!

 

[splxgf]

В самой папке темп ищем? или строго только в подпапках?

 

[Erchizo]

Вот кое что нарыл в хелпах.
Но дальше 5 строки не пошло((. Я так понял .SubFolders в VBA такого понятия нет ?!

Sub Imports()
Dim newf As Document, NewFolder As Object, filpat As String, sef As String, a
Set newf = CreateDocument()
Set NewFolder = CorelScriptTools
filpat = NewFolder.GetFolder("H:\Темп) - здесь всплывает окно для выбора нужной папки
' sef = filpat.SubFolders
' For Each a In sef
' MsgBox a
' Next

End Sub

 

[Erchizo]

В самой папке темп ищем? или строго только в подпапках?

Только в подпапках

 

[_MBK_]

ваша ссылка лично мне не помогла

Эта должна помочь

 

[splxgf]

Эта должна помочь

Ну под задачу походит, только не вкуриваю почему Private Sub EnumSubFolders(ByVal SrcFolder As String, ByVal Folders As Collection)
Если переработать под условия задачи, то нужно выкинуть один цикл перебирающий подпапки и еще не разобрался где выкидывается родительская папка

Private Sub EnumSubFolders(ByVal SrcFolder As String, ByVal Folders As Collection)
    Dim f As String
   
    f = Dir(SrcFolder & "\*.*", vbDirectory)
   
    While f <> ""
        If f <> "." And f <> ".." And (GetAttr(SrcFolder & "\" & f) And vbDirectory) <> 0 Then
            Folders.add SrcFolder & "\" & f
        End If
        f = Dir()
    Wend
End Sub

Private Sub ProcessFolder(ByVal SrcFolder As String)
    Dim f As String, sFolder As Variant
    Dim Folders As New Collection
    Dim n As Long
   
    ' Create a list of folders and subfolders
    EnumSubFolders SrcFolder, Folders
       
    ' Process the CDR files in each of the folders found
    For Each sFolder In Folders
        f = Dir(sFolder & "\*.cdr")
   
        While f <> ""
            ProcessFile sFolder & "\" & f
            f = Dir()
        Wend
    Next sFolder
End Sub

Private Sub ProcessFile(ByVal sFile As String)
    ' Do your file processing here
End Sub

 

[_MBK_]

Ну под задачу походит, только не вкуриваю почему Private Sub EnumSubFolders(ByVal SrcFolder As String, ByVal Folders As Collection)

В смысле что не так?

 

[splxgf]

В смысле что не так?

Передача по значению. Если коллекция меняется в процедуре, то она должна по ссылке передаваться, нормальный компилятор такого бы не пропустил.
Сейчас код погонял, вроде пример в девятом посте текст нормально условия отрабатывает, хотя найдет и .cdr и .cdrx и прочие вариации.

 

[_MBK_]

нормальный компилятор такого бы не пропустил.

Там же не компилятор - интерпретатор
В данном конкретном случае IMHO пофиг ByVal стоит или его не будет - коллекция передается по ссылке

 

[Erchizo]

Ура заработала!
Всем спасибо за помощь. Долго я мучался, но разобрался.
Правда есть еще одна просьба. Во всех этих папках есть фалы автосохранения. "Резервная_копия*.cdr"
Не могли бы вы подсказать как организовать фильтр для таких файлов.
Как бы я не использовал "If" что бы отфильтровать, у меня постоянно ругается f = Dir() из Private Sub ProcessFolder.
Что делать не приложу ума. Полдня на это потратил.

 

[saloed]

средствами vba анализировать имя файла

 

[_MBK_]

Не по теме:
Надеюсь, Лев на меня не обидится, если я, в качестве предисловия, озвучу несколько организационных моментов. @Erchizo, на этом форуме, если вы не заметили, действует правило "один вопрос-одна тема", а вы рискуете превратить данный топик в курс своего онлайн-обучение основам VBA. Вдобавок, вынужден вам снова напомнить про левую кнопку в нижнем углу сообщения, которая хоть как то стимулирует местное население вам помогать. Салоэксперт №2, не надо накручивать себе посты, давая капитанские советы на вопросы, в которых вы не разбираетесь. Этим вы отбиваете хлеб у господина JAW и рискуете испытать действие правой кнопки из этого угла.

Теперь по теме. Вставьте дополнительную проверку

While f <> ""
            if not InStr(f, "Резервная")
             ProcessFile sFolder & "\" & f
            end if

 

[Erchizo]

Прошу прощения за все допущенные мной ошибки при общении.

а вы рискуете превратить данный топик в курс своего онлайн-обучение основам VBA

С этим тоже согласен.
По поводу одобрений могу сказать - об этом я не забываю, вроде на все ваши ответы "одобрения" я нажимал.
В любом случае спасибо

 

[splxgf]

While f <> "" if not InStr(f, "Резервная") ProcessFile sFolder & "\" & f end if

Ну зачем использовать условие таким образом

if InStr(f, "Резервная") = 0 then

читается и портируется проще.

 

[_MBK_]

читается и портируется проще.

Ну въелась уже сишная привычка
Да и код короче