VBA-激活打开的文件

我有一个工作宏，它在文件夹中循环，打开文件，从名称“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

Private子命令按钮1\u单击（）
'设置文件所在的文件夹路径
Const TDS_PATH=“C:\Users\trembos\Documents\TDS\progress\”
'清除当前页面上的所有信息
板材（“板材1”）。范围（“A2:D7557”）。清除
'TextBox1.Text=“.xlsx”
'TextBox1.Font.Italic=True
'输入检查
如果TextBox1.Text=”“，则
MsgBox（“请输入要搜索的文件”）
如果结束
'将WB设置为工作簿
'Set WB=Workbooks.Open（objFile.Name，UpdateLinks:=0）
'设置ws=WB.ActiveSheet
'如果路径中存在我们要搜索的文件
如果是TextBox1.Text“”，则
'禁用屏幕更新以提高性能/美观
Application.ScreenUpdating=False
'打开我们搜索的工作簿（只读）
工作簿。打开TDS_路径和文本框1。文本，只读：=True
设置工作簿=此工作簿
“复制我们感兴趣的范围
Const行标题长度=10
作为对象的Dim objFSO
将文件夹变暗为对象
Dim objFile作为对象
将MyFolder设置为字符串
Dim StartSht作为工作表，ws作为工作表
将WB设置为工作簿
作为整数的Dim i
将最后一行设置为整数，将eRoom设置为整数
变暗高度为整数
暗淡的最后一行
作为字符串的Dim f
作为对象的Dim dict
调光hc作为量程，hc1作为量程，hc2作为量程，hc3作为量程，hc4作为量程，hc5作为量程，d作为量程
Set StartSht=工作簿（“masterfile.xlsm”）.Sheets（“Sheet1”）
MyFolder=“C:\Users\trembos\Documents\TDS\progress\”
设置hc1=头部电池（起始高度范围（“B1”），“支架”）
设定hc2=头槽（起始高度范围（“C1”），“刀具”）
'创建FileSystemObject的实例
设置objFSO=CreateObject（“Scripting.FileSystemObject”）
'获取文件夹对象
设置objFolder=objFSO.GetFolder（MyFolder）
i=2
'设置WB=工作簿
设置ws=ActiveSheet
设置hc=收割台单元格（ws.Cells（第1行收割台），“切削刀具”）
如果不是的话，hc什么都不是
Set dict=GetValues（hc.Offset（1,0），“SplitMe”）
如果dict.count>0，则
Set d=StartSht.Cells（Rows.count，hc2.Column）。End（xlUp）。Offset（1，0）
'将值添加到主列表第3列
d、 调整大小（dict.count，1）.Value=Application.Transpose（dict.items）
如果结束
其他的
'在源工作表上找不到标题
如果结束
'(4)
'在源工作表上查找HOLDER
设置hc3=HeaderCell（ws.Cells（行标题，1），“HOLDER”）
如果不是，那么hc3什么都不是
Set dict=GetValues（hc3.Offset（1,0））
“如果仪表（行标题，“持有人”）”，则
如果dict.count>0，则
Set d=StartSht.Cells（Rows.count，hc1.Column）。End（xlUp）。Offset（1，0）
'将值添加到主列表第2列
d、 调整大小（dict.count，1）.Value=Application.Transpose（dict.items）
如果结束
"完"
其他的
'在源工作表上找不到标题
如果结束
'(5)
与ws
'打印TDS信息
'将文件名打印到第1列
StartSht.Cells（i，1）=TextBox1.Text
StartSht.Range（StartSht.Cells（i，1），StartSht.Cells（GetLastRowInColumn（StartSht，“C”），1））=TextBox1.Text
'将TDS名称从J1单元格打印到第4列
“与ws
.范围（“J1”）.复制起始单元格（i，4）
.Range（“J1”）。复制StartSht.Range（StartSht.Cells（i，4），StartSht.Cells（GetLastRowInColumn（StartSht，“C”），4））
"以
i=获取最后一行数据表（StartSht）+1
'移动到下一个文件
'(6)
'关闭，不保存对打开文件的任何更改
StartSht.d'SaveChanges:=False
以
如果结束
'(7)
'重新打开屏幕更新
ActiveWindow.ScrollRow=1
'重新启用屏幕更新
Application.ScreenUpdating=True
'如果找不到该文件，请告知用户
如果TextBox1.Text=”“，则
MsgBox（“未找到文件！”）
如果结束
端接头
'专用子文本框1_GotFocus（）
'TextBox1.Text=“”
'TextBox1.Font.Italic=False
'末端接头
'(8)
'获取从单元格c开始的所有唯一列值
函数GetValues（ch作为范围，可选vSplit作为变量）作为对象
作为对象的Dim dict
变暗rng As范围，c As范围
暗v
作为变体的Dim spl
Set dict=CreateObject（“scripting.dictionary”）
对于ch.Parent.Range（ch，ch.Parent.Cells（Rows.count，ch.Column.End（xlUp））中的每个c。单元格
v=微调（c值）
如果Len（v）>0且不存在dict（v），则
'排除之后的任何信息'
如果不是IsMissing（vSplit），则
spl=拆分（v，“；”）
v=spl（0）
如果结束
'排除“，”之后的任何信息“
如果不是IsMissing（vSplit），则
spl=拆分（v，“，”）
v=spl（0）
如果结束
地址，地址
如果结束
下一个c
设置GetValues=dict
端函数
'(9)
'查找行上的标题：如果未找到，则不返回任何内容
函数HeaderCell（rng作为范围，sHeader作为字符串）作为范围
尺寸rv As范围，c As范围
对于rng.Parent.Range（rng，rng.Parent.Cells（rng.Row，Columns.count）中的每个c.End（xlToLeft））.Cells
'复制单元格值，如果它包含字符串“holder”或