Страницы: 1
RSS
Игнорирование части названия файла при переборе всех файлов в папке
 
Макрос перебирает в предварительно выбранной папке все файлы с названиями приблизительно следующего характера:

ABC_0213_xyz.xls

Часть ABC неизменна для всех файлов, часть 0213 - месяц и год заполнения соответствующего файла, xyz - набор сокращений, заданный заранее.

При 0213 заданном вручную макрос работает на ура, но необходимо сделать так, чтобы макрос обрабатывал файлы с любыми значениями даты.

Задать все даты ручками можно, но наверняка это не оптимальный ход.

Пробовал вставлять звёздочку "ABC_" & "*" & "_"... Не прокатило.

Подскажите пожалуйста, как это можно реализовать?

Необходимо учесть, что в процессе выполнения макрос прыгает между окном ABC_0213_xyz.xls, которое в каждом цикле открыто только одно, и окном с книгой, в которую и собирается инфа со всех ABC_0213_xyz.xls из выбранной папки.

Заранее благодарю за подсказку)
 
Вы хоть напишите сроки кода при помощи которых перебор осуществляете. а так...
Просмотреть все файлы в папке
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
Может так? "ABC_" & "????" & "_xyz.xls"
 
IF Left(file.Name, 3)="ABC"
 
Так даже проще...
 
Из кода по ссылке как раз вытаскивал часть для выбора папки, в которой лежат обрабатываемые файлы.
"ABC_" & "????" & "_xyz.xls" не прокатило

Код следующий:
fnam = Array("ADY", "ARH", "BEL", "BRY", "CHE", "EVE", "EVR", "IZH", "KAM", "KEM", "KIR", "KLG", "KLN", "KOM", "KOS", "KRA", "KUR", "LIP", "MGD", "MUR", "NEN", "NIN", "NOV", "NSK", "OMS", "ORL", "PSK", "PZV", "ROS", "RYZ", "SAH", "SMO", "SPB", "TAM", "TOM", "TUL", "TVE", "VLA", "VOL", "VRN" ;)

Dim sFolder As String
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show = False Then Exit Sub
sFolder = .SelectedItems(1)
End With

For Each fnam In fnames

Workbooks.Open Filename:=sFolder & "\" & "ABC(неизменная часть)_0213_" & xyz(он же fnam) & ".xls", UpdateLinks:=False

..и дальше пошло-поехало, из открытой книги данные выгружаются в одну общую.

Если не трогать 0213, всё работает идеально, но тогда чтобы выудить файлы другого месяца, придётся лезть в код и перебивать везде дату.

В конце каждого цикла обработанная книга закрывается:
Workbooks("ABC_0213_" & xyz & ".xls" ;) .Close , False

Как внедрить IF Left(file.Name, 3)="ABC" не понял, объясните пожалуйста или возможно есть вариант ещё проще?
Изменено: Shizostereo - 28.05.2013 16:18:34
 
Ну и раз уж такое дело, как сделать так, чтобы макрос не спотыкался, если файл с каким-то конкретными именем отсутствует?

Допустим, если не нашёл файл, кончающийся на ADY, выдаёт ошибку.
Хотелось бы, чтобы просто пропускал и выполнял действия по следующей книге
 
Вариант кода:
Код
Sub Test()
  Const Prefix = "ABC"
  Const Mask = Prefix & "_????_???.xls"
  Dim Folder As String, x
  With Application.FileDialog(msoFileDialogFolderPicker)
    If .Show = False Then Exit Sub
    Folder = .SelectedItems(1)
  End With
  Debug.Print Folder
  x = Dir(Folder & "\" & Mask)
  While Len(x)
    If UCase(x) Like (Prefix & "_####_[A-Z][A-Z][A-Z].XLS") Then
      Debug.Print x
      With Workbooks.Open(Folder & "\" & x)
        .Sheets(1).Range("A1").Value = Now
        .Sheets(1).Columns("A:A").AutoFit
        MsgBox x
        .Close SaveChanges:=False
      End With
    End If
    x = Dir
  Wend
End Sub
 
Цитата

Если не трогать 0213, всё работает идеально, но тогда чтобы выудить файлы другого месяца, придётся лезть в код и перебивать везде дату.

Код
P2=FORMAT(NOW,"MMYY")
Workbooks("ABC_" & P2 & "_" & xyz & ".xls" smile;) .Close , False 
 
Данная команда подставляет месяц и год на момент запуска макроса, а не месяц и год, которыми датирован обрабатываемый файл.

Как-то всё сложно.. Неужели в VBA нет простой 1-2строчной команды, позволяющей игнорировать часть названия файла?)
 
Может быть проще задать пару переменных mm и yy и при запуске макроса выбрасывать текстбокс с запросом месяца и года в соответствующем формате, чтобы эти переменные в виде & mm & yy & сами подставлялись в код?

Просто не хочется городить огород, хочется отделаться простым незамысловатым кодом, в котором потом, если что, смогут разобраться коллеги)
 
For Each fnam In fnames

IF Left(fname,3)="ABC" then

Workbooks.Open Filename:=sFolder & "\" & "ABC(неизменная часть)_0213_" & xyz(он же fnam) & ".xls", UpdateLinks:=False
end if

Так не подходит?
 
Попробую, спасибо)
Страницы: 1
Наверх