Открытие по очереди файлов и работа с ними - Microsoft Office Excel

LLIaMaH · 25.11.2010, 16:10

Суть вопроса проста, открытие по очереди файлов и работа с ним, если такого файла нету переходить к следующему. То есть в папке могут быть таки файлы "00.xls", "01.xls", "02.xls", "03.xls", "04.xls", "05.xls" ... и тд. Открыть файл "00.xls" обработать (тут проблем нет), если файла "00.xls" в папке нет перейти к файлу "01.xls", потом к "02.xls" и тд.

EducatedFool · 25.11.2010, 16:15

Сначала получите имена подходящих файлов в папке: http://excelvba.ru/code/FilenamesCollection

Код:

' считываем в колекцию coll нужные имена файлов' 
    Set coll = FilenamesCollection(ПутьКПапке, "##.xls")

а потом в цикле перебирайте (открывайте и обрабатывайте) эти файлы

LLIaMaH · 25.11.2010, 17:02

Вот часть макроса как он будет выглядеть.

Код:

Workbooks.Open Filename:= _
        "E:\Транзит менеджеры\2010\БЮДЖЕТ\Формы\Ф_1_2_4_5.xls"
    Workbooks.Open Filename:="E:\Транзит менеджеры\2010\БЮДЖЕТ\Формы\Ф_6.xls"
    
    папка = "E:\Транзит менеджеры\2010\БЮДЖЕТ\Формы\ТОБО"
    файл = Dir(папка & "00.xls")   ' ИЩИМ ФАЙЛ
    If Len(файл) = 0 Then  Как здесь прописать если файл не найден переход к следующему файлу???
    
    Dim wb As Workbook: Set wb = Workbooks.Open(папка & файл, UpdateLinks _
        :=0)   ' открываем найденный файл
    wb.Sheets(Array("Доходи-витрати", "Ресурси", "Прирости", "КомТоргРазбивка", _
        "Кошторис форма 2009", "Кассовый результат")).Select
    Sheets("Доходи-витрати").Activate
    Cells.Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Ресурси").Select
    Cells.Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("Ф_1_2_4_5.xls").Activate
    Sheets("Ресурсы_0").Select
    Cells.Select
    ActiveSheet.Paste
    wb.Worksheets("Доходи-витрати").Select
    Cells.Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("Ф_1_2_4_5.xls").Activate
    Sheets("Дох_Расх_0").Select
    Cells.Select
    ActiveSheet.Paste
    wb.Worksheets("КомТоргРазбивка").Select
    Cells.Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("Ф_1_2_4_5.xls").Activate
    Sheets("КТР_0").Select
    Cells.Select
    ActiveSheet.Paste
    wb.Worksheets("Кошторис форма 2009").Select
    Cells.Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("Ф_1_2_4_5.xls").Activate
    Sheets("Смета_0").Select
    Cells.Select
    ActiveSheet.Paste
    wb.Worksheets("Прирости").Select
    Cells.Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("Ф_6.xls").Activate
    Sheets("Прирости_0").Select
    Cells.Select
    ActiveSheet.Paste
    wb.Worksheets("Кассовый результат").Select
    Cells.Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("Ф_6.xls").Activate
    Sheets("Прирости_0").Select
    Cells.Select
    ActiveSheet.Paste
    wb.Worksheets("Кассовый результат").Select
    ActiveWindow.Close SaveChanges:=False
           
           ' ПЕРЕХОД К ФАЙЛУ "01.xls"
    папка = "E:\Транзит менеджеры\2010\БЮДЖЕТ\Формы\ТОБО"
    файл = Dir(папка & "01.xls")   ' ИЩИМ ФАЙЛ
    If Len(файл) = 0 Then ???   ' переход к следующему файлу "02.xls"
    
    Dim wb1 As Workbook: Set wb = Workbooks.Open(папка & файл, UpdateLinks _
        :=0)   ' открываем найденный файл
и тд...

LLIaMaH · 25.11.2010, 17:05

Цитата:

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

Сначала получите имена подходящих файлов в папке: http://excelvba.ru/code/FilenamesCollection

Код:

' считываем в колекцию coll нужные имена файлов' 
    Set coll = FilenamesCollection(ПутьКПапке, "##.xls")

а потом в цикле перебирайте (открывайте и обрабатывайте) эти файлы

А возможно как-то не через функцию, а так как я написал в макросе?

Hugo121 · 25.11.2010, 17:13

Лёгкие пути не для нас?
Если Вам так уж необходимо по-разному обрабатывать каждый файл в зависимости от имени, проверяйте имена полученной коллекции по Like или Select Case.

tae1980 · 25.11.2010, 17:19

Цитата:

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

Вот часть макроса как он будет выглядеть.

Попробуй так.

Код:

Workbooks.Open Filename:= _
        "E:\Транзит менеджеры\2010\БЮДЖЕТ\Формы\Ф_1_2_4_5.xls"
    Workbooks.Open Filename:="E:\Транзит менеджеры\2010\БЮДЖЕТ\Формы\Ф_6.xls"
    
    папка = "E:\Транзит менеджеры\2010\БЮДЖЕТ\Формы\ТОБО"
    for n=0 to 1000
        файл = Dir(папка & Format(n, "00") & ".xls")   ' ИЩИМ ФАЙЛ
        If Len(файл) > 0 Then 
    
            Dim wb As Workbook: Set wb = Workbooks.Open(папка & файл, UpdateLinks _
                :=0)   ' открываем найденный файл
            wb.Sheets(Array("Доходи-витрати", "Ресурси", "Прирости", "КомТоргРазбивка", _
                "Кошторис форма 2009", "Кассовый результат")).Select
            Sheets("Доходи-витрати").Activate
            Cells.Select
            Selection.Copy
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
            Sheets("Ресурси").Select
            Cells.Select
            Application.CutCopyMode = False
            Selection.Copy
            Windows("Ф_1_2_4_5.xls").Activate
            Sheets("Ресурсы_0").Select
            Cells.Select
            ActiveSheet.Paste
            wb.Worksheets("Доходи-витрати").Select
            Cells.Select
            Application.CutCopyMode = False
            Selection.Copy
            Windows("Ф_1_2_4_5.xls").Activate
            Sheets("Дох_Расх_0").Select
            Cells.Select
            ActiveSheet.Paste
            wb.Worksheets("КомТоргРазбивка").Select
            Cells.Select
            Application.CutCopyMode = False
            Selection.Copy
            Windows("Ф_1_2_4_5.xls").Activate
            Sheets("КТР_0").Select
            Cells.Select
            ActiveSheet.Paste
            wb.Worksheets("Кошторис форма 2009").Select
            Cells.Select
            Application.CutCopyMode = False
            Selection.Copy
            Windows("Ф_1_2_4_5.xls").Activate
            Sheets("Смета_0").Select
            Cells.Select
            ActiveSheet.Paste
            wb.Worksheets("Прирости").Select
            Cells.Select
            Application.CutCopyMode = False
            Selection.Copy
            Windows("Ф_6.xls").Activate
            Sheets("Прирости_0").Select
            Cells.Select
            ActiveSheet.Paste
            wb.Worksheets("Кассовый результат").Select
            Cells.Select
            Application.CutCopyMode = False
            Selection.Copy
            Windows("Ф_6.xls").Activate
            Sheets("Прирости_0").Select
            Cells.Select
            ActiveSheet.Paste
            wb.Worksheets("Кассовый результат").Select
            ActiveWindow.Close SaveChanges:=False
        end if
               ' ПЕРЕХОД К ФАЙЛУ "01.xls"
    Next n

LLIaMaH · 25.11.2010, 18:01

Если я правельно понял код будет такой. Открываются только файлы Ф_1_2_4_5.xls и Ф_6.xls на этом макрос завершается. Где-то ошибка.

Код:

Workbooks.Open Filename:= _
        "E:\Транзит менеджеры\2010\БЮДЖЕТ\Формы\Ф_1_2_4_5.xls"
    Workbooks.Open Filename:="E:\Транзит менеджеры\2010\БЮДЖЕТ\Формы\Ф_6.xls"
    
    папка = "E:\Транзит менеджеры\2010\БЮДЖЕТ\Формы\ТОБО"
    for n=0 to 1000
        файл = Dir(папка & Format(n, "00") & ".xls")   ' ИЩИМ ФАЙЛ
        If Len(файл) > 0 Then 
    
            Dim wb As Workbook: Set wb = Workbooks.Open(папка & файл, UpdateLinks _
                :=0)   ' открываем найденный файл
            wb.Sheets(Array("Доходи-витрати", "Ресурси", "Прирости", "КомТоргРазбивка", _
                "Кошторис форма 2009", "Кассовый результат")).Select
            Sheets("Доходи-витрати").Activate
            Cells.Select
            Selection.Copy
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
            Sheets("Ресурси").Select
            Cells.Select
            Application.CutCopyMode = False
            Selection.Copy
            Windows("Ф_1_2_4_5.xls").Activate
            Sheets("Ресурсы_0").Select
            Cells.Select
            ActiveSheet.Paste
            wb.Worksheets("Доходи-витрати").Select
            Cells.Select
            Application.CutCopyMode = False
            Selection.Copy
            Windows("Ф_1_2_4_5.xls").Activate
            Sheets("Дох_Расх_0").Select
            Cells.Select
            ActiveSheet.Paste
            wb.Worksheets("КомТоргРазбивка").Select
            Cells.Select
            Application.CutCopyMode = False
            Selection.Copy
            Windows("Ф_1_2_4_5.xls").Activate
            Sheets("КТР_0").Select
            Cells.Select
            ActiveSheet.Paste
            wb.Worksheets("Кошторис форма 2009").Select
            Cells.Select
            Application.CutCopyMode = False
            Selection.Copy
            Windows("Ф_1_2_4_5.xls").Activate
            Sheets("Смета_0").Select
            Cells.Select
            ActiveSheet.Paste
            wb.Worksheets("Прирости").Select
            Cells.Select
            Application.CutCopyMode = False
            Selection.Copy
            Windows("Ф_6.xls").Activate
            Sheets("Прирости_0").Select
            Cells.Select
            ActiveSheet.Paste
            wb.Worksheets("Кассовый результат").Select
            Cells.Select
            Application.CutCopyMode = False
            Selection.Copy
            Windows("Ф_6.xls").Activate
            Sheets("Прирости_0").Select
            Cells.Select
            ActiveSheet.Paste
            wb.Worksheets("Кассовый результат").Select
            ActiveWindow.Close SaveChanges:=False
        end if
               ' ПЕРЕХОД К ФАЙЛУ "01.xls"
    Next n
Workbooks.Open Filename:= _
        "E:\Транзит менеджеры\2010\БЮДЖЕТ\Формы\Ф_1_2_4_5.xls"
    Workbooks.Open Filename:="E:\Транзит менеджеры\2010\БЮДЖЕТ\Формы\Ф_6.xls"
    
    папка = "E:\Транзит менеджеры\2010\БЮДЖЕТ\Формы\ТОБО"
    for n=1 to 1000
        файл = Dir(папка & Format(n, "00") & ".xls")   ' ИЩИМ ФАЙЛ
        If Len(файл) > 0 Then 
    
            Dim wb1 As Workbook: Set wb = Workbooks.Open(папка & файл, UpdateLinks _
                :=0)   ' открываем найденный файл
            wb1.Sheets(Array("Доходи-витрати", "Ресурси", "Прирости", "КомТоргРазбивка", _
                "Кошторис форма 2009", "Кассовый результат")).Select
            Sheets("Доходи-витрати").Activate
            Cells.Select
            Selection.Copy
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
            Sheets("Ресурси").Select
            Cells.Select
            Application.CutCopyMode = False
            Selection.Copy
            Windows("Ф_1_2_4_5.xls").Activate
            Sheets("Ресурсы_1").Select
            Cells.Select
            ActiveSheet.Paste
            wb1.Worksheets("Кассовый результат").Select
            Cells.Select
            Application.CutCopyMode = False
            Selection.Copy
            Windows("Ф_6.xls").Activate
            Sheets("Прирости_1").").Select
            Cells.Select
            ActiveSheet.Paste
            wb1.Worksheets("Кассовый результат").Select
            ActiveWindow.Close SaveChanges:=False
        end if
               ' ПЕРЕХОД К ФАЙЛУ "02.xls"
    Next n

tae1980 · 25.11.2010, 19:38

Цитата:

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

Если я правельно понял код будет такой. Открываются только файлы Ф_1_2_4_5.xls и Ф_6.xls на этом макрос завершается. Где-то ошибка.

Код:

Workbooks.Open Filename:= _
        "E:\Транзит менеджеры\2010\БЮДЖЕТ\Формы\Ф_1_2_4_5.xls"
    Workbooks.Open Filename:="E:\Транзит менеджеры\2010\БЮДЖЕТ\Формы\Ф_6.xls"
    
    папка = "E:\Транзит менеджеры\2010\БЮДЖЕТ\Формы\ТОБО"
    for n=0 to 1000
        файл = Dir(папка & Format(n, "00") & ".xls")   ' ИЩИМ ФАЙЛ
        If Len(файл) > 0 Then 
 <Сожрал хомяк>
        end if
               ' ПЕРЕХОД К ФАЙЛУ "01.xls"
    Next n
Workbooks.Open Filename:= _
        "E:\Транзит менеджеры\2010\БЮДЖЕТ\Формы\Ф_1_2_4_5.xls"
    Workbooks.Open Filename:="E:\Транзит менеджеры\2010\БЮДЖЕТ\Формы\Ф_6.xls"
    
    папка = "E:\Транзит менеджеры\2010\БЮДЖЕТ\Формы\ТОБО"
    for n=1 to 1000
        файл = Dir(папка & Format(n, "00") & ".xls")   ' ИЩИМ ФАЙЛ
        If Len(файл) > 0 Then 
 <Сожрал хомяк>
        end if
               ' ПЕРЕХОД К ФАЙЛУ "02.xls"
    Next n

Тут уж извини, без этих файлов мне трудно что либо проверить.

Код:

Sub qqq()
    папка = "c:\"
    n = 1
    qq = папка & Format(n, "00") & ".xls"
End Sub

Дает qq="c:\01.xls" путь сформировался верно. Посмотри у себя, при пошаговом выполнении какие пути собираются. Кажется тебе в переменную "папка" нужно дописать замыкающую "\"
За чем тебе два цикла над одними и теме же файлами?

Код:

Workbooks.Open Filename:= "E:\Транзит менеджеры\2010\БЮДЖЕТ\Формы\Ф_1_2_4_5.xls"
Workbooks.Open Filename:="E:\Транзит менеджеры\2010\БЮДЖЕТ\Формы\Ф_6.xls"
папка = "E:\Транзит менеджеры\2010\БЮДЖЕТ\Формы\ТОБО"

Цикл for n формирует только нумерацию файлов.
Проверка If Len(файл) > 0 дает только выполнение кода только в случае если файл есть.
Dim wb As Workbook можно перенести в начало макроса.

LLIaMaH · 26.11.2010, 10:58

Ошибку я нашел. Работет нормально но есть один нюанс. Файл "00.xls" он находит, открывает, выполняет прописаные с ним действия. Если файла "00.xls" нет он переходит к файлу "01.xls" с этим проблем нет. Но когда он переходит к файлу "01.xls" он начинает выполнять действия прописаные под файл "00.xls", а не под файл "01.xls". Получается что под все файлы "00.xls", "01.xls", "02.xls"... он выполнет одно итоже. Мне нужно чтоб он под каждый файл выполнял действия прописаные специально под него, у всех они будут разные. То что получилось в прикрепленном файле.

tae1980 · 26.11.2010, 11:09

Цитата:

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

Ошибку я нашел. Работет нормально но есть один нюанс. Файл "00.xls" он находит, открывает, выполняет прописаные с ним действия. Если файла "00.xls" нет он переходит к файлу "01.xls" с этим проблем нет. Но когда он переходит к файлу "01.xls" он начинает выполнять действия прописаные под файл "00.xls", а не под файл "01.xls". Получается что под все файлы "00.xls", "01.xls", "02.xls"... он выполнет одно итоже. Мне нужно чтоб он под каждый файл выполнял действия прописаные специально под него, у всех они будут разные. То что получилось в прикрепленном файле.

И сколько у тебя файлов всего? :))
Воспользуйся командой select. Для разделения действий по каждому файлу, или тем же if.
Советую для каждого файла создать свою процедуру, а в основном цикле всего лишь вызывать нужную процедуру.

25.11.2010, 16:10	#1
LLIaMaH Пользователь Регистрация: 22.09.2010 Сообщений: 14	Открытие по очереди файлов и работа с ними Суть вопроса проста, открытие по очереди файлов и работа с ним, если такого файла нету переходить к следующему. То есть в папке могут быть таки файлы "00.xls", "01.xls", "02.xls", "03.xls", "04.xls", "05.xls" ... и тд. Открыть файл "00.xls" обработать (тут проблем нет), если файла "00.xls" в папке нет перейти к файлу "01.xls", потом к "02.xls" и тд.

25.11.2010, 16:15	#2
EducatedFool Программист VBA СуперМодератор Регистрация: 13.07.2008 Сообщений: 6,856	Сначала получите имена подходящих файлов в папке: http://excelvba.ru/code/FilenamesCollection Код: `' считываем в колекцию coll нужные имена файлов' Set coll = FilenamesCollection(ПутьКПапке, "##.xls")` а потом в цикле перебирайте (открывайте и обрабатывайте) эти файлы __Полезные надстройки для Excel. Парсинг сайтов и файлов. Макросы любой сложности на заказ. Мониторинг цен конкурентов

25.11.2010, 17:13	#5
Hugo121 Старожил Регистрация: 11.05.2010 Сообщений: 5,166	Лёгкие пути не для нас? Если Вам так уж необходимо по-разному обрабатывать каждый файл в зависимости от имени, проверяйте имена полученной коллекции по Like или Select Case. webmoney: E265281470651 Z422237915069 R418926282008

Похожие темы
Тема	Автор	Раздел	Ответов	Последнее сообщение
Автофильтры и работа с ними	Lego	Microsoft Office Excel	16	18.10.2010 23:48
Классы и работа с ними	Airou	Общие вопросы C/C++	1	16.10.2010 04:53
Создание файлов и работа с ними...	Olka...	Общие вопросы C/C++	12	02.04.2010 23:30
базы данных DBF и работа с ними	ИВэТэшка	Помощь студентам	3	06.03.2009 15:05
Скачка файлов из инета по очереди	koyotfgthispass	Работа с сетью в Delphi	17	24.12.2008 17:50