Как закрыть внешний Excel, открытый из локальной ссылки vlookup на vba

Question

Я пытаюсь закрыть другую книгу Excel, открытую из моего активного Excel, при вызове vlookup, который ссылается на этот другой Excel. Самое близкое, что я мог получить, это закрыть книгу, но Excel остается открытым. Я не хотел быть радикальным и закрыть все экземпляры Excel, поскольку это закроет другие рабочие книги, не вовлеченные в процесс. Основной Sub, называемый InsertLookup, вызывает другие Sub. Я могу закрыть активный Excel, но тот, который открыт vlookup (OtherExcel.Xlsx), остается открытым. Я не хочу, чтобы какой-либо из двух файлов Excel, участвующих в процессе, оставался открытым.

Option Explicit


Public RemoteRowCount As Long
Public LocalRowCount As Long

Function Is_WorkBook_Open(ByVal strWorkbookName As String) As Boolean
    Dim wb As Workbook

    On Error Resume Next
    Set wb = Workbooks(strWorkbookName)
    If Err Then
        Is_WorkBook_Open = False
    Else
        Is_WorkBook_Open = True
    End If
End Function


Sub GetRemoteRowCount()
    Dim LastRowRemote As Long

    Dim WkBks As Workbook
    Dim WShts As Worksheet
    Workbooks.Open Filename:="C:\local\OtherExcel.Xlsx"


    If Is_WorkBook_Open("OtherExcel.Xlsx") Then
        Set WkBks = Workbooks("OtherExcel.Xlsx")
    Else
        Workbooks.Open Filename:="C:\test\OtherExcel.Xlsx"
    End If
    Set WShts = WkBks.Worksheets("FirstSheet")
    LastRowRemote = WShts.Cells.Find(What:="*", SearchDirection:=xlPrevious).Row
    RemoteRowCount = LastRowRemote
End Sub


Sub GetLocalRowCount()
    Dim LastRowLocal As Long
    Dim WShts As Worksheet
    ThisWorkbook.Activate
    Set WShts = ThisWorkbook.Worksheets("OtherSheet")
    LastRowLocal = WShts.Cells.Find(What:="*", SearchDirection:=xlPrevious).Row
    LocalRowCount = LastRowLocal
    'MsgBox (LocalRowCount)
End Sub


Sub InsertLookup()
    Call GetRemoteRowCount
    Call GetLocalRowCount

    Dim rng As Range, cell As Range, LastValue As String, i As Integer    

    For i = 3 To LocalRowCount
        If IsNumeric(Cells(i, "G").Value) = True And IsEmpty(Cells(i, "G").Value) = False Then
            LastValue = "=VLOOKUP(" & Cells(i, "N").Offset(, -7).Value & ",[OtherExcel.XLSX]FirstSheet!R13C1:R" & RemoteRowCount & "C12,10,0)"
            Cells(i, "N").Formula = LastValue
        End If
    Next i

    ActiveWorkbook.Save
    ActiveWorkbook.Close

    Call DeleteAllSubs
    Call CloseExcel
End Sub


Sub DeleteAllSubs()
    Dim otmp As Object

    With ActiveWorkbook.VBProject
        For Each otmp In .VBComponents
            If otmp.Type=100 Then
                otmp.CodeModule.DeleteLines 1, otmp.CodeModule.CountOfLines
                otmp.CodeModule.CodePane.Window.Close
            Else: .VBComponents.Remove otmp
            End If
        Next otmp
    End With
End Sub


Option Explicit

Public RemoteRowCount As Long
Public LocalRowCount As Long

Function Is_WorkBook_Open(ByVal strWorkbookName As String) As Boolean
    Dim wb As Workbook

    On Error Resume Next
    Set wb = Workbooks(strWorkbookName)
    If Err Then
        Is_WorkBook_Open = False
    Else
        Is_WorkBook_Open = True
    End If
End Function


Sub GetRemoteRowCount()
    Dim LastRowRemote As Long

    Dim WkBks As Workbook
    Dim WShts As Worksheet
    Workbooks.Open Filename:="C:\local\OtherExcel.Xlsx"


    If Is_WorkBook_Open("OtherExcel.Xlsx") Then
        Set WkBks = Workbooks("OtherExcel.Xlsx")
    Else
        Workbooks.Open Filename:="C:\test\OtherExcel.Xlsx"
    End If
    Set WShts = WkBks.Worksheets("FirstSheet")
    LastRowRemote = WShts.Cells.Find(What:="*", SearchDirection:=xlPrevious).Row
    RemoteRowCount = LastRowRemote
End Sub


Sub GetLocalRowCount()
    Dim LastRowLocal As Long
    Dim WShts As Worksheet
    ThisWorkbook.Activate
    Set WShts = ThisWorkbook.Worksheets("OtherSheet")
    LastRowLocal = WShts.Cells.Find(What:="*", SearchDirection:=xlPrevious).Row
    LocalRowCount = LastRowLocal
    'MsgBox (LocalRowCount)
End Sub


Sub InsertLookup()
    Call GetRemoteRowCount
    Call GetLocalRowCount


    Dim rng As Range, cell As Range, LastValue As String, i As Integer    

    For i = 3 To LocalRowCount
        If IsNumeric(Cells(i, "G").Value) = True And IsEmpty(Cells(i, "G").Value) = False Then
            LastValue = "=VLOOKUP(" & Cells(i, "N").Offset(, -7).Value & ",[OtherExcel.XLSX]FirstSheet!R13C1:R" & RemoteRowCount & "C12,10,0)"
            Cells(i, "N").Formula = LastValue
        End If
    Next i

    ActiveWorkbook.Save
    ActiveWorkbook.Close

    Call DeleteAllSubs
    Call CloseExcel
End Sub


Sub DeleteAllSubs()
    Dim otmp As Object

    With ActiveWorkbook.VBProject
        For Each otmp In .VBComponents
            If otmp.Type=100 Then
                otmp.CodeModule.DeleteLines 1, otmp.CodeModule.CountOfLines
                otmp.CodeModule.CodePane.Window.Close
            Else: .VBComponents.Remove otmp
            End If
        Next otmp
    End With
End Sub


Option Explicit

Public RemoteRowCount As Long
Public LocalRowCount As Long

Function Is_WorkBook_Open(ByVal strWorkbookName As String) As Boolean
    Dim wb As Workbook

    On Error Resume Next
    Set wb = Workbooks(strWorkbookName)
    If Err Then
        Is_WorkBook_Open = False
    Else
        Is_WorkBook_Open = True
    End If
End Function


Sub GetRemoteRowCount()
    Dim LastRowRemote As Long

    Dim WkBks As Workbook
    Dim WShts As Worksheet
    Workbooks.Open Filename:="C:\local\OtherExcel.Xlsx"


    If Is_WorkBook_Open("OtherExcel.Xlsx") Then
        Set WkBks = Workbooks("OtherExcel.Xlsx")
    Else
        Workbooks.Open Filename:="C:\test\OtherExcel.Xlsx"
    End If
    Set WShts = WkBks.Worksheets("FirstSheet")
    LastRowRemote = WShts.Cells.Find(What:="*", SearchDirection:=xlPrevious).Row
    RemoteRowCount = LastRowRemote
End Sub
Sub GetLocalRowCount()
    Dim LastRowLocal As Long
    Dim WShts As Worksheet
    ThisWorkbook.Activate
    Set WShts = ThisWorkbook.Worksheets("OtherSheet")
    LastRowLocal = WShts.Cells.Find(What:="*", SearchDirection:=xlPrevious).Row
    LocalRowCount = LastRowLocal
    'MsgBox (LocalRowCount)
End Sub


Sub InsertLookup()
    Call GetRemoteRowCount
    Call GetLocalRowCount


    Dim rng As Range, cell As Range, LastValue As String, i As Integer    

    For i = 3 To LocalRowCount
        If IsNumeric(Cells(i, "G").Value) = True And IsEmpty(Cells(i, "G").Value) = False Then
            LastValue = "=VLOOKUP(" & Cells(i, "N").Offset(, -7).Value & ",[OtherExcel.XLSX]FirstSheet!R13C1:R" & RemoteRowCount & "C12,10,0)"
            Cells(i, "N").Formula = LastValue
        End If
    Next i

    ActiveWorkbook.Save
    ActiveWorkbook.Close

    Call DeleteAllSubs
    Call CloseExcel
End Sub


Sub DeleteAllSubs()
    Dim otmp As Object

    With ActiveWorkbook.VBProject
        For Each otmp In .VBComponents
            If otmp.Type=100 Then
                otmp.CodeModule.DeleteLines 1, otmp.CodeModule.CountOfLines
                otmp.CodeModule.CodePane.Window.Close
            Else: .VBComponents.Remove otmp
            End If
        Next otmp
    End With
End Sub


Option Explicit

Public RemoteRowCount As Long
Public LocalRowCount As Long

Function Is_WorkBook_Open(ByVal strWorkbookName As String) As Boolean
    Dim wb As Workbook

    On Error Resume Next
    Set wb = Workbooks(strWorkbookName)
    If Err Then
        Is_WorkBook_Open = False
    Else
        Is_WorkBook_Open = True
    End If
End Function


Sub GetRemoteRowCount()
    Dim LastRowRemote As Long

    Dim WkBks As Workbook
    Dim WShts As Worksheet
    Workbooks.Open Filename:="C:\local\OtherExcel.Xlsx"


    If Is_WorkBook_Open("OtherExcel.Xlsx") Then
        Set WkBks = Workbooks("OtherExcel.Xlsx")
    Else
        Workbooks.Open Filename:="C:\test\OtherExcel.Xlsx"
    End If
    Set WShts = WkBks.Worksheets("FirstSheet")
    LastRowRemote = WShts.Cells.Find(What:="*", SearchDirection:=xlPrevious).Row
    RemoteRowCount = LastRowRemote
End Sub


Sub GetLocalRowCount()
    Dim LastRowLocal As Long
    Dim WShts As Worksheet
    ThisWorkbook.Activate
    Set WShts = ThisWorkbook.Worksheets("OtherSheet")
    LastRowLocal = WShts.Cells.Find(What:="*", SearchDirection:=xlPrevious).Row
    LocalRowCount = LastRowLocal
    'MsgBox (LocalRowCount)
End Sub


Sub InsertLookup()
    Call GetRemoteRowCount
    Call GetLocalRowCount


    Dim rng As Range, cell As Range, LastValue As String, i As Integer    

    For i = 3 To LocalRowCount
        If IsNumeric(Cells(i, "G").Value) = True And IsEmpty(Cells(i, "G").Value) = False Then
            LastValue = "=VLOOKUP(" & Cells(i, "N").Offset(, -7).Value & ",[OtherExcel.XLSX]FirstSheet!R13C1:R" & RemoteRowCount & "C12,10,0)"
            Cells(i, "N").Formula = LastValue
        End If
    Next i

ActiveWorkbook.Save
ActiveWorkbook.Close

Call DeleteAllSubs
Call CloseExcel
End Sub


Sub DeleteAllSubs()
    Dim otmp As Object

    With ActiveWorkbook.VBProject
        For Each otmp In .VBComponents
            If otmp.Type=100 Then
                otmp.CodeModule.DeleteLines 1, otmp.CodeModule.CountOfLines
                otmp.CodeModule.CodePane.Window.Close
            Else: .VBComponents.Remove otmp
            End If
        Next otmp
    End With
End Sub
Option Explicit



Public RemoteRowCount As Long
Public LocalRowCount As Long

Function Is_WorkBook_Open(ByVal strWorkbookName As String) As Boolean
    Dim wb As Workbook

    On Error Resume Next
    Set wb = Workbooks(strWorkbookName)
    If Err Then
        Is_WorkBook_Open = False
    Else
        Is_WorkBook_Open = True
    End If
End Function


Sub GetRemoteRowCount()
    Dim LastRowRemote As Long

    Dim WkBks As Workbook
    Dim WShts As Worksheet
    Workbooks.Open Filename:="C:\local\OtherExcel.Xlsx"


    If Is_WorkBook_Open("OtherExcel.Xlsx") Then
        Set WkBks = Workbooks("OtherExcel.Xlsx")
    Else
        Workbooks.Open Filename:="C:\test\OtherExcel.Xlsx"
    End If
    Set WShts = WkBks.Worksheets("FirstSheet")
    LastRowRemote = WShts.Cells.Find(What:="*", SearchDirection:=xlPrevious).Row
    RemoteRowCount = LastRowRemote
End Sub


Sub GetLocalRowCount()
    Dim LastRowLocal As Long
    Dim WShts As Worksheet
    ThisWorkbook.Activate
    Set WShts = ThisWorkbook.Worksheets("OtherSheet")
    LastRowLocal = WShts.Cells.Find(What:="*", SearchDirection:=xlPrevious).Row
    LocalRowCount = LastRowLocal
    'MsgBox (LocalRowCount)
End Sub

Sub InsertLookup()
    Call GetRemoteRowCount
    Call GetLocalRowCount


    Dim rng As Range, cell As Range, LastValue As String, i As Integer    

    For i = 3 To LocalRowCount
        If IsNumeric(Cells(i, "G").Value) = True And IsEmpty(Cells(i, "G").Value) = False Then
            LastValue = "=VLOOKUP(" & Cells(i, "N").Offset(, -7).Value & ",[OtherExcel.XLSX]FirstSheet!R13C1:R" & RemoteRowCount & "C12,10,0)"
            Cells(i, "N").Formula = LastValue
        End If
    Next i

    ActiveWorkbook.Save
    ActiveWorkbook.Close

    Call DeleteAllSubs
    Call CloseExcel
End Sub


Sub DeleteAllSubs()
    Dim otmp As Object

    With ActiveWorkbook.VBProject
        For Each otmp In .VBComponents
            If otmp.Type=100 Then
                otmp.CodeModule.DeleteLines 1, otmp.CodeModule.CountOfLines
                otmp.CodeModule.CodePane.Window.Close
            Else: .VBComponents.Remove otmp
            End If
        Next otmp
    End With
End Sub