L oop через диапазон, чтобы открыть соответствующие файлы

Question

У меня есть список имен файлов * .xlsm на листе с именем «DB» в диапазоне от E961 до E1010 (50 строк), и я пытаюсь создать макрос, который проходит через этот список и открывает соответствующие файлы в set, запускает некоторый код и закрывает файл, переходя к следующему файлу в списке - повторяя эту операцию каждые 5 минут.

Каталог содержит 400+ файлов xlsm, и список в E961 обычно будет меньше 50 файлов - поэтому я не пытаюсь открыть все файлы в каталоге. Это уже происходит раз в день в установленное время.

Но я пытаюсь открыть эти файлы из «короткого списка» и, например, обновлять их каждые 5 минут. Я пробовал разные комбинации кода, но не могу заставить его работать.

Основной файл, содержащий этот код, также находится в том же каталоге, чтобы разрешить относительные ссылки на другие 400+ файлов, отсюда и код ThisWorkbook.Path.

Отредактированный код ниже:

Sub UPDATE()

Application.ScreenUpdating = True
With ThisWorkbook.Worksheets("DB")
    Dim inputRange As Range
    Set inputRange = .Range("E961", .Cells(.Rows.Count, 5).End(xlUp))
End With

Dim directory As String: directory = ThisWorkbook.Path & "\"
Dim fileName As String
Dim r As Range
Dim xlwb As Workbook
For Each r In inputRange
    If r <> vbNullString Then
        fileName = Dir(directory & r & ".xl??*")
        Set xlwb = Workbooks.Open(directory & fileName)


                Application.DisplayAlerts = False
                ActiveWorkbook.RefreshAll

                    If Range("A4") > Sheets("DB").Cells(Rows.Count, "A").End(xlUp).Offset(0) Then

                    Worksheets("DB").Range("A4:L4").Select
                    Worksheets("DB").Range("A4").Activate
                    Selection.Copy
                    Sheets("DB").Select
                    Sheets("DB").Cells(Rows.Count, "A").End(xlUp).Offset(1). _
                    PasteSpecial Paste:=xlPasteValues, _
                    SkipBlanks:=True, Transpose:=False
                    Application.CutCopyMode = False

                    Else
                    End If

                    If Range("A4") = Sheets("DB").Cells(Rows.Count, "A").End(xlUp).Offset(0) Then

                    Worksheets("DB").Range("A4:L4").Select
                    Worksheets("DB").Range("A4").Activate
                    Selection.Copy
                    Sheets("DB").Select
                    Sheets("DB").Cells(Rows.Count, "A").End(xlUp).Offset(0). _
                    PasteSpecial Paste:=xlPasteValues, _
                    SkipBlanks:=True, Transpose:=False
                    Application.CutCopyMode = False

                    End If

        xlwb.Close True
    End If
Next r

Application.ScreenUpdating = True

End Sub

Ошибка возникает из-за «Set xlwb = (sht.Cells (Row, 1) .Value)», потому что он пытается открыть лист как книгу, но я не знаю, как это исправить ... или все не так ...

Спасибо за помощь!

Answer 1

Попробуйте этот кусок, он должен работать, потому что он будет открывать и закрывать только книги, пока вы не дадите ему код для работы с ними:

Option Explicit
Sub UPDATE()

    Application.ScreenUpdating = False
    'if you are only using here your wb and sht variables, use a With, there is no need to use variables
    With ThisWorkbook.Worksheets("DB")
        Dim inputRange As Range
        'It is preferable to do xlUp because you could find some empty cells in between.
        Set inputRange = .Range("E961", .Cells(.Rows.Count, 5).End(xlUp))
    End With

    Dim directory As String: directory = ThisWorkbook.Path & "\"
    Dim fileName As String
    Dim r As Range
    Dim xlwb As Workbook
    For Each r In inputRange
        If r <> vbNullString Then
            fileName = Dir(directory & r & ".xl??*") 'don't know if your cell has the extension
            Set xlwb = Workbooks.Open(directory & fileName)
            'some code
            xlwb.Close False 'False won't save the workbook, use True if you want it to be saved.
        End If
    Next r

    Application.ScreenUpdating = True

End Sub