Пакетная обработка файлов

[Orange Fox]

Есть макрос в VBA в Exele, который открывает файл *.doc берет оттуда данные анкеты и добавляет их в сводную таблицу, где они сортируются для дальнейшего добавления в базу.
Анкет около тысячи...
Подскажите как организовать пакетную обработку чтоб этот долгий процесс происходил без участия человека.

зы Я только начинаю в этом разбираться.
Поиск дал только короткие темы где просят не задавать глупых вопросов

Код: Выделить всё

[bi-lya]

Вы должны сначала для себя составить общий алгоритм решения этой задачи. Потом уже разбираться с тем, как реализовать каждый из пунктов этого алгоритма. И только тогда вы можете задавать на форуме конкретные вопросы по конкретным проблемам (это насчет "глупых вопросов").
Для начала вопрос: вордовские файлы УЖЕ существуют? Или они будут создаваться специально для этого приложения?

[Orange Fox]

Да, вордовские файлы уже существуют (к сожалению) иначе бы, конечно испльзовал Exel дабы не плодить сущьности.
Более того - код тоже есть и он умеет практически все, что мне нужно от него, за исключением расстановки индексов (это я сам доделаю) и возможности действовать самостоятельно вот тут я даже не знаю.... как это реализовать.

Цель передо мной стоит следующая: из заданной дирректории в любом порядке вычитать все файлы.

собственно сам код:

Код: Выделить всё

Sub Макрос_вставка_анкет_сверху_попорядку()
'
' Сочетание клавиш: Ctrl+q

Dim f As Variant
   
  f = Application.GetOpenFilename("Документы Word (*.doc),*.doc")
  If VarType(f) = vbString Then
    With CreateObject("Word.Application")
      With .documents.Open(f)
        If .tables.Count > 0 Then
          .tables(1).Range.Copy
         
            With ThisWorkbook.Worksheets.Add
             ActiveSheet.Name = "temp"
             ActiveSheet.PasteSpecial Format:="Текст в кодировке Unicode"
             End With
        End If
      End With
      .Quit False
    End With
  End If
 
' Копирование из Temp'a в bufer
 
    Range("A1:K85").Select
    Selection.Copy
    Sheets("bufer").Select
    Range("A1:K85").Select
    ActiveSheet.Paste

' Удаление Temp'a "без шума"
    Sheets("temp").Select
    Application.DisplayAlerts = False
    ActiveSheet.Delete
    Application.DisplayAlerts = True

' Заполнение таблицы собсно
..... 
эту часть пропускаю т.к. она велика и для дела не важна   
....

End Sub
[syntax="vb"][/syntax]

[alibek]

В чем вопрос?
Как имеющийся макрос применить ко всем файлам в определенном каталоге?
1. В макрос добавить параметр f As String, строку с "f = Application.GetOpenFilename("Документы Word (*.doc),*.doc")" убрать.
2. Дописать такой код:

Код: Выделить всё

Sub EnumFiles()
Dim P As String, F As String
P = "C:\Мои документы\Анкеты\"
F = Dir$(P & "*.doc")
Do Until Len(F) = 0
  Call Макрос_вставка_анкет_сверху_попорядку(P & F)
  F = Dir$()
Loop
End Sub

Но по хорошему, макрос Макрос_вставка_анкет_сверху_попорядку надо переделать, он будет неудобен в использовании.

[Orange Fox]

Спасибо за внимание и столь оперативный ответ.
Сам был в отъезде поэтому пишу только сейчас

Задача несколько усложнилась:
Есть рабочая папка например c:\base\
В ней лежат папки с именами анкетируемых вида ivanov, petrov, sidorov
А уже в папках лежат анкеты вида ivanov.doc petrov.doc и.т.д. т.е. в каждой папке одна анкета с расширением *.doc и именем совпадающим с дирректорией и куча графических файлов (сканы анкет, фотки)

Теперь вопрос
Как применить макрос к каждому файлу поочереди, при этом после применения папка данной анкеты должна быть переименована в ID этой анкеты

[Orange Fox]

Нашел способ решения поставленной задачи в VB теперь вопрос только в том, как передать управление к ранее написанному макросу в Exele. И можно ли его использовать в качестве внешней функции для VB.

[Orange Fox]

УРА, товарищи !!!!

Я нашел ответы к большей части своих вопросов.
Ниже приведен код для рекурсивного поиска файлов в заданной дирректории (у меня это c:\base ) т.е. пути к каждому файлу определяются и записываются в коллекцию SeachFolders при необходимости коллекцию можно очистить (см процедуру DelSF).

Осталось все это собрать с моим основным кодом и найти ответ на вопрос как получать пути из SeachFolders, и как переименовывавать папку, содержащую активный файл.

О дальнейших продвижениях сообщу. В скором времени выложу нормальный окончательный код.

alibek извини, чувствую что был неправ

Код: Выделить всё

Public Sub LookingFor()
      'Для поиска файлов используется объект FileSearch
      Dim Report As String
      Dim i As Integer
      With Application.FileSearch
           .NewSearch
           .FileType = msoFileTypeWordDocuments
           .LastModified = msoLastModifiedAnyTime
           .LookIn = "c:\base\"
           .SearchSubFolders = True
           .MatchTextExactly = False
           
            If .Execute(SortBy:=msoSortByLastModified, _
                     SortOrder:=msoSortOrderDescending) > 0 Then
                Report = "Найдено " & .FoundFiles.Count & " файлов!" & vbCrLf
               For i = 1 To .FoundFiles.Count
                    Report = Report & .FoundFiles(i) & vbCrLf
               Next i
               Call MsgBox(Report, vbInformation, "Отчет о найденных файлах!")
            End If
       End With
   
End Sub

Код: Выделить всё



[code]Public Sub DelSF()
      'Чистка коллекции папок SearchFolders
      Dim num     As Long
      With Application.FileSearch
           For num = 1 To .SearchFolders.Count
                .SearchFolders.Remove 1
           Next num
      End With
  End Sub[/code]

[Orange Fox]

Макрос рекурсивного поиска был переработан и дополнен
Теперь список путей выдается в первом столбце первого листа моей книги, откуда я буду их забирать для дальнейшей обработки каждого из этих файлов.

Код: Выделить всё

Public Sub sniffer_dog()
      'Для поиска файлов используется объект FileSearch
      Dim Report As String
      Dim i As Integer
      With Application.FileSearch
           .NewSearch
           .FileType = msoFileTypeWordDocuments
           .LookIn = "c:\base\"
           .SearchSubFolders = True
                       
            If .Execute(SortBy:=msoSortByFileName = 2, _
                     SortOrder:=msoSortOrderDescending) > 0 Then
                   ' цикл заполнения ячеек путями
               For i = 1 To .FoundFiles.Count
                    Range("A" & i).Value = .FoundFiles(i)
                    Next i
               End If
       End With
   
End Sub