VBA - Активировать открытый файл

Question

У меня есть рабочий макрос, который просматривает папку, чтобы открывать файлы и получать важную информацию из столбцов имен «HOLDER» и «CUTTING TOOL» и распечатывать всю информацию до одного документа excel, masterfile. Он также печатает имя файла в столбце 1 и имя «Лист данных инструментов» в столбце 4.

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

Любые идеи по переключению активного листа без определенного имени?

Private Sub CommandButton1_Click() 


'Set folder path where the file is located 
Const TDS_PATH = "C:\Users\trembos\Documents\TDS\progress\" 

'Clear out any info on current page 
Sheets("Sheet1").Range("A2:D7557").Clear 

'TextBox1.Text = ".xlsx" 
'TextBox1.Font.Italic = True 

'input checking 
If TextBox1.Text = "" Then 
    MsgBox ("Please enter a file to search for") 
End If 


'Dim WB As Workbook 
'Set WB = Workbooks.Open(objFile.Name, UpdateLinks:=0) 
'Set ws = WB.ActiveSheet 


'If the File we are searching for exists in the path 
If TextBox1.Text <> "" Then 

    'Disable screen updating for performance/aesthetics 
    Application.ScreenUpdating = False 

    'Open the workbook we searched for (ReadOnly) 
    Workbooks.Open TDS_PATH & TextBox1.Text, ReadOnly:=True 
    Set Workbook = ThisWorkbook 

    'Copy the range we are interested in 



    Const ROW_HEADER As Long = 10 

    Dim objFSO As Object 
    Dim objFolder As Object 
    Dim objFile As Object 
    Dim MyFolder As String 
    Dim StartSht As Worksheet, ws As Worksheet 
    Dim WB As Workbook 
    Dim i As Integer 
    Dim LastRow As Integer, erow As Integer 
    Dim Height As Integer 
    Dim FinalRow As Long 
    Dim f As String 
    Dim dict As Object 
    Dim hc As Range, hc1 As Range, hc2 As Range, hc3 As Range, hc4 As Range, hc5 As Range, d As Range 

    Set StartSht = Workbooks("masterfile.xlsm").Sheets("Sheet1") 

    MyFolder = "C:\Users\trembos\Documents\TDS\progress\" 

    Set hc1 = HeaderCell(StartSht.Range("B1"), "HOLDER") 
    Set hc2 = HeaderCell(StartSht.Range("C1"), "CUTTING TOOL") 


    'create an instance of the FileSystemObject 
    Set objFSO = CreateObject("Scripting.FileSystemObject") 
    'get the folder object 
    Set objFolder = objFSO.GetFolder(MyFolder) 

    i = 2 

     'Set WB = Workbooks 
     Set ws = ActiveSheet 

     Set hc = HeaderCell(ws.Cells(ROW_HEADER, 1), "CUTTING TOOL") 
     If Not hc Is Nothing Then 

      Set dict = GetValues(hc.Offset(1, 0), "SplitMe") 
      If dict.count > 0 Then 
       Set d = StartSht.Cells(Rows.count, hc2.Column).End(xlUp).Offset(1, 0) 
       'add the values to the master list, column 3 
       d.Resize(dict.count, 1).Value = Application.Transpose(dict.items) 
      End If 
     Else 
      'header not found on source worksheet 
     End If 
'(4) 
     'find HOLDER on the source sheet 
     Set hc3 = HeaderCell(ws.Cells(ROW_HEADER, 1), "HOLDER") 
     If Not hc3 Is Nothing Then 
      Set dict = GetValues(hc3.Offset(1, 0)) 
      'If InStr(ROW_HEADER, "HOLDER") <> "" Then 
      If dict.count > 0 Then 
       Set d = StartSht.Cells(Rows.count, hc1.Column).End(xlUp).Offset(1, 0) 
       'add the values to the master list, column 2 
       d.Resize(dict.count, 1).Value = Application.Transpose(dict.items) 
      End If 
      'End If 
     Else 
      'header not found on source worksheet 
     End If 

'(5) 
    With ws 
     'print TDS information 
       'print the file name to Column 1 
       StartSht.Cells(i, 1) = TextBox1.Text 
       StartSht.Range(StartSht.Cells(i, 1), StartSht.Cells(GetLastRowInColumn(StartSht, "C"), 1)) = TextBox1.Text 

       'print TDS name from J1 cell to Column 4 
       'With ws 
        .Range("J1").Copy StartSht.Cells(i, 4) 
        .Range("J1").Copy StartSht.Range(StartSht.Cells(i, 4), StartSht.Cells(GetLastRowInColumn(StartSht, "C"), 4)) 
       'End With 
       i = GetLastRowInSheet(StartSht) + 1 
     'move to next file 
'(6) 
     'close, do not save any changes to the opened files 
     StartSht.d 'SaveChanges:=False 
    End With 

End If 

'(7) 
'turn screen updating back on 
ActiveWindow.ScrollRow = 1 

    'Re-enable screen updating 
    Application.ScreenUpdating = True 

    'Let the user know if the file is not found 
If TextBox1.Text = "" Then 
    MsgBox ("File not found!") 
End If 

End Sub 

'Private Sub TextBox1_GotFocus() 
' TextBox1.Text = "" 
' TextBox1.Font.Italic = False 
'End Sub 

'(8) 
'get all unique column values starting at cell c 
Function GetValues(ch As Range, Optional vSplit As Variant) As Object 
    Dim dict As Object 
    Dim rng As Range, c As Range 
    Dim v 
    Dim spl As Variant 

    Set dict = CreateObject("scripting.dictionary") 

    For Each c In ch.Parent.Range(ch, ch.Parent.Cells(Rows.count, ch.Column).End(xlUp)).Cells 
     v = Trim(c.Value) 
     If Len(v) > 0 And Not dict.exists(v) Then 

      'exclude any info after ";" 
      If Not IsMissing(vSplit) Then 
      spl = Split(v, ";") 
      v = spl(0) 
      End If 

      'exclude any info after "," 
      If Not IsMissing(vSplit) Then 
      spl = Split(v, ",") 
      v = spl(0) 
      End If 

      dict.Add c.Address, v 
     End If 
    Next c 
    Set GetValues = dict 
End Function 

'(9) 
'find a header on a row: returns Nothing if not found 
Function HeaderCell(rng As Range, sHeader As String) As Range 
    Dim rv As Range, c As Range 
    For Each c In rng.Parent.Range(rng, rng.Parent.Cells(rng.Row, Columns.count).End(xlToLeft)).Cells 
     'copy cell value if it contains some string "holder" or "cutting tool" 
     If InStr(c.Value, sHeader) <> 0 Then 
      Set rv = c 
      Exit For 
     End If 
    Next c 
    Set HeaderCell = rv 
End Function 

'(10) 
Function GetLastRowInColumn(theWorksheet As Worksheet, col As String) 
    With theWorksheet 
     GetLastRowInColumn = .Range(col & .Rows.count).End(xlUp).Row 
    End With 
End Function 


'(11) 
Function GetLastRowInSheet(theWorksheet As Worksheet) 
Dim ret 
    With theWorksheet 
     If Application.WorksheetFunction.CountA(.Cells) <> 0 Then 
      ret = .Cells.Find(What:="*", _ 
          After:=.Range("A1"), _ 
          LookAt:=xlPart, _ 
          LookIn:=xlFormulas, _ 
          SearchOrder:=xlByRows, _ 
          SearchDirection:=xlPrevious, _ 
          MatchCase:=False).Row 
     Else 
      ret = 1 
     End If 
    End With 
    GetLastRowInSheet = ret 
End Function 

Answer 1

У вас уже есть ответ в вашем коде:
set wb=workbooks.open...
и когда вы это больше не нужно просто wb.close.

Другой подход мог бы перебрать все открытые книги и проверьте их имена:
For Each wb In Application.Workbooks
If wb.name=textbox1.text Then wb.close
Next wb