Excel run macro in another workbook, reference data on the first then close them both. Only one will close

Question

I have a templated Excel file that will be is used to save the cell values to SQL. There will be about a thousand of these all with different names that perform the same function. For this reason I wanted to remove my code from the template into another file allowing for global changes if needed.

The User works from File A and hits the save button executing the following code to run the Macro contained in File B.

Sub Save_Inspection()
   Dim wb As Workbook
   On Error Resume Next
   Set wb = Workbooks("SaveInspectionData.xlsm")
   On Error GoTo 0
   If wb Is Nothing Then Set wb = Workbooks.Open("\\SERVER\FOLDER\Files\XDomainDocs\SaveInspectionData.xlsm")
   Dim FileName As String
   FileName = ThisWorkbook.Name
   Run "SaveInspectionData.xlsm!sheet1.Save_Inspection", FileName
   wb.Close False
   Set wb = Nothing
End Sub

Below is the code used to save the data residing on File B. Note - it is undermentioned at this time how many rows or columns there will, so I am looping through to create the SQL query and qty of rows, columns etc. This all works fine.

My problem is when I try to close the workbooks. I want them both to close and regardless or what I try only one of the two will close. The code below reflects the simplest close method, but I have tried several other techniques.

After some searching it may be something to do with my use of "With" statements to reference File A, but I am not sure.

Thanks in advance!

Sub Save_Inspection(FileName As String)
On Error GoTo errH

Dim strUserDomain As String
Dim cn As ADODB.Connection
Dim Server_Name As String
Dim Database_Name As String
Dim User_ID As String
Dim Password As String

Dim InspectionId As Integer 'Will use this Id to associate all results to this Inspection Instance

Dim Query As String
Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset

'Find proper connection string
strUserDomain = Environ$("UserDomain")
`If strUserDomain = "A" Then
    Server_Name = "ServerA"
    Database_Name = "Inspection"
    User_ID = "xxx"
    Password = "xxx"
ElseIf strUserDomain = "B" Then
    Server_Name = "ServerB"
    Database_Name = "Inspection"
    User_ID = "xxx"
    Password = "xxx"
ElseIf strUserDomain = "C" Then
    Server_Name = "ServerC"
    Database_Name = "Inspection"
    User_ID = "xxx"
    Password = "xxx"
Else
    'Something must be wrong
    Exit Sub
End If

Workbooks(FileName).Activate
Dim wb As Workbook
Dim ws As Worksheet
Set wb = Workbooks(FileName)
Set ws = wb.Sheets(1)

'Let's Save this stuff!
Dim DateInspected, PartNumber, LotNumber, Revision As String
'Set values
With ws
    'DateInspected = .Range("Q5").Value
    PartNumber = .Range("K4").Value
    LotNumber = .Range("G3").Value
    Revision = .Range("Q4").Value
End With
Query = "INSERT INTO InspectionCatalog (DateInspected, PartNumber, LotNumber, Revision) VALUES (GETDATE(), '" & PartNumber & "', '" & LotNumber & "', '" & Revision & "')"

Set cn = New ADODB.Connection
cn.Open "Provider=SQLOLEDB;Server=" & Server_Name & ";Initial Catalog=" & Database_Name & ";Uid=" & User_ID & ";Pwd=" & Password & ";"

cn.Execute (Query)
rs.Open "SELECT @@identity AS InspectionId", cn
InspectionId = rs.Fields("InspectionId")
'MsgBox (InspectionId)'For testing

'Loop through all cells on sheet and save results
Call LoopThroughResults(InspectionId, FileName, strUserDomain)

Exit Sub
    errH:
    MsgBox Err.Description
End Sub

Sub LoopThroughResults(InspectionId As Integer, FileName As String, strUserDomain As String)
On Error GoTo errH

'Declare Variables
Dim RowCount As Integer
Dim CollCount As Integer
Dim Coll_Count As Integer

Dim wb As Workbook
Dim ws As Worksheet
Set wb = Workbooks(FileName)
Set ws = wb.Sheets(1)

'Find the number of rows in the sheet based on a value in Col U
With ws
    RowCount = .Cells(.Rows.Count, "G").End(xlUp).Row
    'MsgBox RowCount
End With

'Go through each row and find the number of columns that are filled
'Set CollCount to the longest row - ignoring 1-9 these are header fields
For i = 10 To RowCount
With ws
    Coll_Count = .Cells(i, .Columns.Count).End(xlToLeft).Column
    If Coll_Count > CollCount Then
    'Find the length of the longest row
    CollCount = Coll_Count
    End If
    'MsgBox "Row " & i & " Has " & Coll_Count & " Columns!"
End With
Next i
'MsgBox "The Row with the Most data has " & CollCount & " Columns!"

'Save Col Count to be used for retrieving the data later
Dim Query As String
Query = "UPDATE InspectionCatalog SET CollCount='" & CollCount & "', [RowCount]='" & RowCount & "' WHERE InspectionId='" & InspectionId & "' "
Call SaveResults(Query, strUserDomain)

Dim QueryStart As String
Dim QueryEnd As String

'Loop through each row starting at 2 (Not 10, this time we want to capture all data
For i = 2 To RowCount
'Reset Query String befor hitting next row
QueryStart = "INSERT INTO InspectionResults ("
QueryEnd = " VALUES ("
'Loop through each column to create insert query
    For n = 1 To CollCount
            QueryStart = QueryStart & "Col" & n & ","
            QueryEnd = QueryEnd & "N'" & Workbooks(FileName).Worksheets("Inspection Report").Cells(i, n).Value & "',"
    Next n
    QueryStart = QueryStart & "InspectionId)"
    QueryEnd = QueryEnd & "'" & InspectionId & "');"
    'MsgBox QueryStart & QueryEnd
    Call SaveResults(QueryStart & QueryEnd, strUserDomain)
Next i

MsgBox "Inspection Data Has Been Saved"
Call CloseWorkBooks(FileName)

Exit Sub
errH:
    MsgBox Err.Description
End Sub

Sub SaveResults(Query As String, strUserDomain As String)
On Error GoTo errH
Dim cn As ADODB.Connection
Dim Server_Name As String
Dim Database_Name As String
Dim User_ID As String
Dim Password As String

Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset

'Find proper connection string
strUserDomain = Environ$("UserDomain")

If strUserDomain = "A" Then
    Server_Name = "ServerA"
    Database_Name = "Inspection"
    User_ID = "xxx"
    Password = "xxx"
ElseIf strUserDomain = "B" Then
    Server_Name = "ServerB"
    Database_Name = "Inspection"
    User_ID = "xxx"
    Password = "xxx"
ElseIf strUserDomain = "C" Then
    Server_Name = "ServerC"
    Database_Name = "Inspection"
    User_ID = "xxx"
    Password = "xxx"
Else
    'Something must be wrong
    Exit Sub
End If

Set cn = New ADODB.Connection
cn.Open "Provider=SQLOLEDB;Server=" & Server_Name & ";Initial Catalog=" & Database_Name & ";Uid=" & User_ID & ";Pwd=" & Password & ";"
cn.Execute (Query)
Exit Sub
errH:
    MsgBox Err.Description
End Sub

Sub CloseWorkBooks(FileName As String)
    Workbooks(FileName).Close SaveChanges:=False
    Workbooks("SaveInspectionData.xlsm").Close SaveChanges:=False
    Exit Sub
End Sub

Answer 1

Above Oliver does a great job explaining why my procedures where not working properly. In order to fix this I removed the call's to close the workbooks, the code in workbook A handles that on it's own. I did make some small changes to the above code to handle closing Excel or the workbook based on the qty of instances open.

Sub Save_Inspection()
Dim wb As Workbook
Dim wb2 As Workbook
On Error Resume Next
Set wb = Workbooks("SaveInspectionData.xlsm")
On Error GoTo 0
If wb Is Nothing Then Set wb = Workbooks.Open("\\Server\Cloud9\Files\XDomainDocs\SaveInspectionData.xlsm")
Dim FileName As String
FileName = ThisWorkbook.Name
Run "SaveInspectionData.xlsm!sheet1.Save_Inspection", FileName
If Application.Workbooks.Count > 2 Then
    wb.Close False
    ThisWorkbook.Close False
    Set wb = Nothing
Else
    Application.Quit
End If
End Sub

Answer 2

Note that Application.Run executes the code in the same 'environment' as the current workbook. Basically the workbook executing Application.Run is the one running the code, and the new workbook will be linked to the same session. This will result in the peculiar situation that you are observing. Closing the workbook executed by 'Run' will make any macro (sub, function, object, sheet) in this workbook go out of scope, and any code run will stop running in this workbook. In addition as the notebook was closed, the code will not 'finish' in the executed workbook and thus we will not return to the original workbook, effectively halting any execution in the original notebook.

Additionaly as the code will try to return to the original workbook, to finish the original running sub (here Save_Inspection() in the original workbook), the two workbooks are linked to the same session (or environment), and thus closing this workbook first will Halt the original code running (going to the next line in Save_Inspection becomes effectively impossible as the workbook is now closed), and this will end the session as well.

Thus closing all workbooks in a workbook opened and executed by Application.Run is not possible directly. Workarounds can be done. The simplest is closing all workbooks in the original workbook (placing wb.close false: Thisworkbook.close false after application.run). Alternatively making a sub in the second workbook that runs 'Application.Ontime' and saves the filename to a cell for use in the function run by 'ontime' should make certain that the two sessions wont be linked while running code in the second notebook. But this i am less certain is actually the case.

Below is the code in the original notebook. If the original workbook finishes this should close the workbooks in the end.

Sub Save_Inspection()
   Dim wb As Workbook
   On Error Resume Next
   Set wb = Workbooks("SaveInspectionData.xlsm")
   On Error GoTo 0
   If wb Is Nothing Then
    Set wb = Workbooks.Open(ThisWorkbook.Path & "SaveInspectionData.xlsm")
   End If
   Dim FileName As String
   FileName = ThisWorkbook.Name
   Run "SaveInspectionData.xlsm!sheet1.CloseBooks", FileName
   wb.Close False
   ThisWorkbook.Close False
   Set wb = Nothing
End Sub