Excel VBA Макросы: Чем заменить FileSearch?

Автор Ольга, 01 октября 2018, 11:58

Ольга

Подскажите, как написать макрос если нужно:
Открыть определенную папку с файлами Эксель (Например: С/Данные).
Из каждого файла скопировать данные из ячейки А2 и вставить в файл макроса. И так с каждым файлом, что есть в папке.
В Экселе 2003 я это делала с помощью FileSearch, в новом экселе этот метод заблокирован.
Как исправить макрос?

Пример старого макроса
Sub сбор_данных_для_конференции()

Dim y As Integer
Dim k As Integer
Dim Kniga, NameBook As String

Kniga = ActiveWorkbook.Name

Application.FileSearch.Filename = "*.xls"
Application.FileSearch.LookIn = "C:\Данные"
Application.FileSearch.Execute

For y = 1 To Application.FileSearch.FoundFiles.Count
Workbooks.Open (Application.FileSearch.FoundFiles(y)), UpdateLinks = 1
NameBook = ActiveWorkbook.Name

Workbooks(Kniga).Worksheets("показатели").Cells(y + 1, 1) = Left(Right(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 13), Len(ActiveWorkbook.Name) - 25)

Workbooks(Kniga).Worksheets("показатели").Cells(y + 1, 2) = Workbooks(NameBook).Worksheets("БПУ Ф21").Cells(12, 17) 
Workbooks(Kniga).Worksheets("показатели").Cells(y + 1, 3) = Workbooks(NameBook).Worksheets("БПУ Ф21").Cells(15, 17) 
Workbooks(Kniga).Worksheets("показатели").Cells(y + 1, 4) = Workbooks(NameBook).Worksheets("БПУ Ф21").Cells(18, 17)
Workbooks(Kniga).Worksheets("показатели").Cells(y + 1, 5) = Workbooks(NameBook).Worksheets("БПУ Ф21").Cells(21, 17)
Workbooks(Kniga).Worksheets("показатели").Cells(y + 1, 6) = Workbooks(NameBook).Worksheets("БПУ Ф21").Cells(24, 17)

ActiveWorkbook.Close

Next y

End Sub
[свернуть]

Администратор

У метода Open, у параметра UpdateLinks два значения: 0, 3. Вы указываете 1. В офиц. справке написано про два значения.

После параметра нужно ставить двоеточие: UpdateLinks:=0.
В вашем случае макрос создавал переменную с именем 'UpdateLinks' и проверял, есть ли в ней 1. Т.r. в переменной 'UpdateLinks' нет 1, то возвращалось 'False' и в параметр 'UpdateLinks' подставлялось 'False', что соответствует 0. То есть у вас в параметр 'UpdateLinks' подставлялся 0.
Чтобы не было таких скрытых ошибок, можно указывать вверху модуля Option Explicit: https://forumvba.ru/index.php?topic=402.0

Макрос
Sub сбор_данных_для_конференции()
   
    Dim path As String, FileName As String
    Dim Kniga as String, NameBook As String
    Dim r As Long
   
    Kniga = ActiveWorkbook.Name
   
    ' Запись в переменную пути, где находятся файлы.
    path = "C:\Данные"
   
    ' Задаём, какие файлы нужно обработать.
    FileName = Dir(path & "\" & "*.xls")
   
    ' Просматриваем указанные файлы.
        ' Если в переменной 'FileName' стала пустая строка, значит все файлы просмотрены.
    r = 1
    Do While FileName <> ""
        Workbooks.Open FileName:=path & "\" & FileName, UpdateLinks:=0
        NameBook = ActiveWorkbook.Name
        r = r + 1
        Workbooks(Kniga).Worksheets("показатели").Cells(r, 1) = Left(Right(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 13), Len(ActiveWorkbook.Name) - 25)
       
        Workbooks(Kniga).Worksheets("показатели").Cells(r, 2) = Workbooks(NameBook).Worksheets("БПУ Ф21").Cells(12, 17)
        Workbooks(Kniga).Worksheets("показатели").Cells(r, 3) = Workbooks(NameBook).Worksheets("БПУ Ф21").Cells(15, 17)
        Workbooks(Kniga).Worksheets("показатели").Cells(r, 4) = Workbooks(NameBook).Worksheets("БПУ Ф21").Cells(18, 17)
        Workbooks(Kniga).Worksheets("показатели").Cells(r, 5) = Workbooks(NameBook).Worksheets("БПУ Ф21").Cells(21, 17)
        Workbooks(Kniga).Worksheets("показатели").Cells(r, 6) = Workbooks(NameBook).Worksheets("БПУ Ф21").Cells(24, 17)
       
        ActiveWorkbook.Close
       
        ' Переход к следующему файлу.
        FileName = Dir()
       
    Loop
   
End Sub
[свернуть]

Ольга