Const MyPath = "C:\Temp\"
    Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
    
    On Error Resume Next
    
    Do
        tfExit = False
        Set colItems = objWMIService.ExecQuery("Select * from Win32_Process") ' where Win32_Process.Name=""excel.exe""")
        If Not colItems Is Nothing Then
            For Each objItem In colItems
            If LCase(objItem.Name) = "excel.exe" Then
                tfExit = True
                Set ObjXL = GetObject(, "Excel.Application")
                If Not ObjXL Is Nothing Then
                    ObjXL.Application.DisplayAlerts = False
                    For Each Wb In ObjXL.Workbooks
                      If Not Wb.Saved Then
                        Wb.SaveAs MyPath & Wb.Name
                        Wb.Close False
                      End If
                    Next
                    ObjXL.Application.DisplayAlerts = True
                    ObjXL.Quit
                    Set ObjXL = Nothing
                End If
                Exit For
            End If
            Next
        End If
    Loop While tfExit