Quit application only if this is the only work book

[tony.reynolds]

I have a workbook called orders.xlsm. it operates entirely from userform so therfore i have the workbook hidden and the user can only see the userform.

on the close of the userform the code is as bleow.

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If CloseMode = vbFormControlMenu Then
    If Not NewOrderSupplier = Empty Then
    Dim Msg, Style, Title, Response
    Msg = "It looks like you have started an order." & Chr(10) & "Do you want to cancel this order?"
    Style = vbYesNo + vbQuestion + vbDefaultButton2
    Title = "OrderStocker"
    Response = MsgBox(Msg, Style, Title)
        If Response = vbYes Then
        GoTo CloseWB
        Else
        Cancel = True
        Exit Sub
        End If
    End If

CloseWB:
Unload Me
ActiveWorkbook.Save
Application.Visible = True

Application.Quit
End If

End Sub

The only trouble i have is if i have another workbook open when I open Orders.xlsm it is still open in the same instance. so when this code is called the excell try to quit and if the other workbook is not saved it askes if you want to save before closing.

I would like to check

if
Orders .xlsm is the only workbook open then 

Workbooks("Orders.xlsm").Save
Application.Visible = True
Application.Quit

else

Workbooks("Orders.xlsm").Save
Application.Visible = True
Workbooks("Orders.xlsm").Close

Please anyone let me know if this can be done.

 

[GTO]

A bit sloppy, but by example:

Names:

Add userform, name it: 'frmReplicate'
Add a label to the form, name it: 'lblInstruct'

In frmReplicate:

Option Explicit
    
Dim NewXLInstance As Excel.Application
    
Private Sub UserForm_Activate()
Dim wb      As Workbook
Dim lFilNum As Long
    
    '// esnure paint                                                                    //
    DoEvents
    
    lFilNum = 1
    '// see function                                                                    //
    If Replicate(lFilNum, wb) Then
        '// Since we blocked showing form before, run a short script to delay and show  //
        '// the form in the new instance                                                //
        NewXLInstance.Run "Module1.ShowForm"
        
        Set NewXLInstance = Nothing
        
        '// Kill replicant                                                              //
        With ThisWorkbook
            .ChangeFileAccess xlReadOnly
            .Saved = True
            Kill ThisWorkbook.FullName
            .Close False
        End With
    Else
        '// UNTESTED; you'll want to play with error handling to ensure nothing hangs.  //
        Set NewXLInstance = Nothing
        Application.Visible = True
        MsgBox "Failed.  Closing"
        ThisWorkbook.Close False
    End If
    Unload Me
End Sub
    
Private Sub UserForm_Initialize()
    '// setup form, change to suit.                                                     //
    With Me
        .BackColor = &H0&
        .Caption = vbNullString
        .Height = 61.5
        .Width = 240
        With .lblInstruct
            .BackStyle = fmBackStyleTransparent
            .Caption = "Please wait... I am opening a new instance."
            .Font.Name = "Tahoma"
            .Font.Size = 11
            .Height = 24
            .Left = 0
            .Width = .Parent.Width
            .TextAlign = fmTextAlignCenter
            .Top = 6
        End With
    End With
End Sub
    
Private Function Replicate(fileID As Long, wb As Workbook) As Boolean
Dim Path        As String
Dim MeName      As String
Dim TempName    As String
    
    '// Save orig name, path, and give initial val to TempName                          //
    Path = ThisWorkbook.Path & "\"
    MeName = ThisWorkbook.Name
    TempName = Format(fileID, "000000") & ".xls*"
    
    '// Doubt we'd run into a file named '000001.xls', but ensure we don't name temp file//
    '// same as existing.                                                               //
    If Len(Dir(Path & TempName)) Then
        Do While Len(Dir(Path & TempName))
            fileID = fileID + 1
            TempName = Format(fileID, "000000") & ".xls*"
        Loop
    End If
    
    '// replicate, change extension and fileformat to suit.                             //
    ThisWorkbook.SaveAs Path & Format(fileID, "000000") & ".xls"
    '// Set a reference to a new app instance                                           //
    Set NewXLInstance = New Excel.Application
    
    '// Set a reference, we are now opening the original wb.                            //
    With NewXLInstance
        Set wb = .Workbooks.Open(Path & MeName)
    End With
    
    Replicate = True
End Function

In ThisWorkbook:

Option Explicit
    
Private Sub Workbook_Open()
    '// IF the app is visible OR the app was started by the user.  So... will not test  //
    '// TRUE when this is opened in the created instance, as we'll keep it hidden.      //
    If Application.UserControl Then
        If Workbooks.Count > 1 Then
            frmReplicate.Show
        Else
            UserForm1.Show
        End If
    End If
End Sub

In a Standard Module named 'Module1':

Option Explicit
    
Public Function ShowForm()
    Application.OnTime Now() + TimeValue("00:00:03"), "ExecuteForm"
End Function
    Public Function ExecuteForm()
         UserForm1.Show
    End Function

NOTE:

Userform1 is just a respresentation of your form. The only code I placed in Userform1 is:

Option Explicit
    
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    Application.Visible = True
End Sub

...to ensure I didn't end up with an instance floating about.

Hope that helps,

Mark

 

[tony.reynolds]

Thanks for that it works fine and with a few mods and itegrate with existing modules it is all working how i wanted it.

Thanks for your help

 

[GTO]

You are most welcome