Использование диапазона для ввода данных в имя файла

Question

Добрый день. У меня возникла проблема с этим кодом. Он отлично работает, если я разрешаю книгу Excel читать, а затем закрываю ее с помощью функции ActiveWorkbook.Close. Если я прокомментирую функцию .close, я получаю ошибку времени выполнения. Я хотел бы, чтобы все книги открывались и открывались.

Answer 1

Нечто подобное (непроверенные)

Sub openwb1() 

    Dim EPath As String, EFile As String, EMo As String 
    Dim EVar As String, lastrow As Long, counter As Long, EFound As String 
    Dim wb As Workbook 

    lastrow = Worksheets("Opener").Cells(Rows.Count, 1).End(xlUp).Row 

    'next two lines do not need to be inside the loop 
    EPath = "Q:\MY PATH\" 
    EMo = MonthName(DatePart("m", Now), True) & " " & DatePart("yyyy", Now) & "\" 

    For counter = 1 To lastrow 

     EVar = Worksheets("Opener").Range("A" & counter).Value 

     If Len(Dir(EPath & EVar & EMo, vbDirectory)) = 0 Then 

      MkDir EPath & EVar & EMo 

     Else 
      'only check for a file if the source folder was found... 
      EFound = Dir(EPath & EVar & EMo & "*$*.xlsx") 

      If EFound <> "" Then 
       Set wb = Workbooks.Open(Filename:=EPath & EVar & EMo & "\" & EFound) 

       'do something with wb 

       wb.Close False 'don't save changes? 

      End If 

     End If 

    Next counter 

End Sub 

Answer 2

Попробуйте изменить EVar = Worksheets("Opener").Range("A" & counter).Value к EVar = Thisworkbook.Worksheets("Opener").Range("A" & counter).Value.

BTW, lastrow = Worksheets("Opener").Cells(Worksheets("Opener").Rows.Count, 1).End(xlUp).Row можно изменить на lastrow = Worksheets("Opener").Cells(Rows.Count, 1).End(xlUp).Row, потому что каждый рабочий лист в этой книге имеет то же самое Rows.Count. Вам не нужно указывать, какую рабочую таблицу считать.