This will do the above in my previous post. The only limitation I placed on it was the inability to open the same workbook in another instance (as ReadOnly). If you attempt to open the workbook in another instance at the same time, the read-only version will close it'self without prompt. The code will not allow other workbooks to be opened in "this" instance but will force them to open them in their own instance. Once a second instance has been created, it will be used for all other workbooks unless you purposely open your own instance. This code in any workbook should effectively "orphan" the workbook. If you try to open this workbook in an instance that already contains one or more workbooks, this workbook will close and reopen it'self in a new instance. See the download for a better understanding.
MyLonelyWorkbook.zip
<table border="1" bgcolor="White"><caption ALIGN=left>
<font size="2" face=Courier New>Example VBA Code:</FONT></caption><tr><td><font size="2" face=Courier New> <font color="#0000A0">Option</font> <font color="#0000A0">Explicit</font>
<font color="#0000A0">Private</font> <font color="#0000A0">Declare</font> <font color="#0000A0">Function</font> SetForegroundWindow <font color="#0000A0">Lib</font> "user32" _
(ByVal hWnd <font color="#0000A0">As</font> Long) <font color="#0000A0">As</font> <font color="#0000A0">Long</font>
<font color="#0000A0">Private</font> <font color="#0000A0">Declare</font> <font color="#0000A0">Function</font> FindWindow <font color="#0000A0">Lib</font> "user32" <font color="#0000A0">Alias</font> "FindWindowA" _
(ByVal lpClassName <font color="#0000A0">As</font> String, <font color="#0000A0">ByVal</font> lpWindowName <font color="#0000A0">As</font> String) <font color="#0000A0">As</font> <font color="#0000A0">Long</font>
<font color="#0000A0">Private</font> <font color="#0000A0">WithEvents</font> pParentApp <font color="#0000A0">As</font> Application
<font color="#0000A0">Private</font> pAuxiliaryInstance <font color="#0000A0">As</font> Application
<font color="#0000A0">Private</font> pPersonalXls <font color="#0000A0">As</font> <font color="#0000A0">String</font>
<font color="#0000A0">Private</font> pIsLoaded <font color="#0000A0">As</font> <font color="#0000A0">Boolean</font>
<font color="#0000A0">Private</font> <font color="#0000A0">Sub</font> Workbook_Open()
SetUpOrpan
<font color="#0000A0">End</font> <font color="#0000A0">Sub</font>
<font color="#0000A0">Private</font> <font color="#0000A0">Sub</font> SetUpOrpan()
<font color="#0000A0">Dim</font> Wb <font color="#0000A0">As</font> Workbook
<font color="#008000"> 'get an instance to "PERSONAL.XLS" if it is loaded</font>
<font color="#0000A0">On</font> <font color="#0000A0">Error</font> <font color="#0000A0">Resume</font> <font color="#0000A0">Next</font>
<font color="#0000A0">If</font> ThisWorkbook.ReadOnly <font color="#0000A0">Then</font>
ThisWorkbook.Close False
<font color="#0000A0">End</font> <font color="#0000A0">If</font>
<font color="#0000A0">Set</font> Wb = Workbooks("PERSONAL.XLS")
<font color="#0000A0">On</font> <font color="#0000A0">Error</font> <font color="#0000A0">GoTo</font> 0
<font color="#0000A0">If</font> Workbooks.Count > 1 <font color="#0000A0">And</font> Wb <font color="#0000A0">Is</font> <font color="#0000A0">Nothing</font> <font color="#0000A0">Then</font>
<font color="#008000"> 'PERSONAL.XLS not loaded</font>
<font color="#008000"> 'other workbooks are already open in this instance</font>
<font color="#008000"> 'open ThisWorkbook in a new instance of Excel.Application</font>
CloseMeAndStartMeInNewInstance
<font color="#0000A0">ElseIf</font> Workbooks.Count > 2 <font color="#0000A0">Then</font>
<font color="#008000"> 'PERSONAL.XLS may or may not be loaded. Does not matter at this point</font>
<font color="#008000"> 'other workbooks are already open in this instance</font>
<font color="#008000"> 'open ThisWorkbook in a new instance of Excel.Application</font>
CloseMeAndStartMeInNewInstance
<font color="#0000A0">Else</font>
<font color="#008000"> 'this instance is ok to open ThisWorkbook</font>
<font color="#008000"> 'close PERSONAL.XLS in this instance</font>
<font color="#0000A0">If</font> <font color="#0000A0">Not</font> Wb <font color="#0000A0">Is</font> <font color="#0000A0">Nothing</font> <font color="#0000A0">Then</font>
pPersonalXls = Wb.FullName
Wb.Close
<font color="#0000A0">End</font> <font color="#0000A0">If</font>
<font color="#008000"> 'continue opening in this instance</font>
<font color="#008000"> 'start watching the application level events to</font>
<font color="#008000"> 'respond to any attempts to create a new workbook</font>
<font color="#008000"> 'or to open an existing workbook</font>
<font color="#0000A0">Set</font> pParentApp = Application
<font color="#0000A0">End</font> <font color="#0000A0">If</font>
<font color="#0000A0">End</font> <font color="#0000A0">Sub</font>
<font color="#0000A0">Public</font> <font color="#0000A0">Property</font> <font color="#0000A0">Get</font> IsLoaded() <font color="#0000A0">As</font> <font color="#0000A0">Boolean</font>
IsLoaded = pIsLoaded
<font color="#0000A0">End</font> <font color="#0000A0">Property</font>
<font color="#008000">'should only set this reference from VBScript</font>
<font color="#0000A0">Public</font> <font color="#0000A0">Property</font> <font color="#0000A0">Set</font> AuxiliaryInstance(app <font color="#0000A0">As</font> Excel.Application)
<font color="#0000A0">If</font> pAuxiliaryInstance <font color="#0000A0">Is</font> <font color="#0000A0">Nothing</font> <font color="#0000A0">Then</font>
<font color="#0000A0">Set</font> pAuxiliaryInstance = app
<font color="#0000A0">End</font> <font color="#0000A0">If</font>
<font color="#0000A0">End</font> <font color="#0000A0">Property</font>
<font color="#0000A0">Private</font> <font color="#0000A0">Sub</font> Workbook_BeforeClose(Cancel <font color="#0000A0">As</font> Boolean)
<font color="#0000A0">If</font> <font color="#0000A0">Not</font> pAuxiliaryInstance <font color="#0000A0">Is</font> <font color="#0000A0">Nothing</font> <font color="#0000A0">Then</font>
<font color="#008000"> 'if the user closes the Auxiliary Instance but we still have a reference</font>
<font color="#008000"> 'to the application, we will have an orphaned proccess running invisibly</font>
<font color="#008000"> 'this will close it</font>
<font color="#0000A0">If</font> <font color="#0000A0">Not</font> pAuxiliaryInstance.Visible <font color="#0000A0">Then</font>
pAuxiliaryInstance.Quit
<font color="#0000A0">Set</font> pAuxiliaryInstance = <font color="#0000A0">Nothing</font>
<font color="#0000A0">End</font> <font color="#0000A0">If</font>
<font color="#0000A0">End</font> <font color="#0000A0">If</font>
<font color="#0000A0">End</font> <font color="#0000A0">Sub</font>
<font color="#0000A0">Private</font> <font color="#0000A0">Sub</font> pParentApp_NewWorkbook(ByVal Wb <font color="#0000A0">As</font> Workbook)
<font color="#008000"> 'close the newly created workbook and open it in the Auxiliary Instance</font>
Wb.Close False
CreateNewOrGetExistingInstance
pAuxiliaryInstance.Workbooks.Add
SetForegroundWindow FindWindow("XLMAIN", pAuxiliaryInstance.Caption)
<font color="#0000A0">End</font> <font color="#0000A0">Sub</font>
<font color="#0000A0">Private</font> <font color="#0000A0">Sub</font> pParentApp_WorkbookOpen(ByVal Wb <font color="#0000A0">As</font> Workbook)
<font color="#008000"> 'close the newly opened workbook and re-open it in the Auxiliary Instance</font>
<font color="#0000A0">Dim</font> WorkbookFullName <font color="#0000A0">As</font> <font color="#0000A0">String</font>
<font color="#0000A0">If</font> Wb.FullName = ThisWorkbook.FullName <font color="#0000A0">Then</font>
<font color="#0000A0">If</font> <font color="#0000A0">Not</font> pIsLoaded <font color="#0000A0">Then</font> <font color="#0000A0">Exit</font> <font color="#0000A0">Sub</font>
MsgBox "Only one instance of this workbook may be opened..."
Wb.Close False
<font color="#0000A0">End</font> <font color="#0000A0">If</font>
WorkbookFullName = Wb.FullName
Wb.Close False
CreateNewOrGetExistingInstance
pAuxiliaryInstance.Workbooks.Open WorkbookFullName
SetForegroundWindow FindWindow("XLMAIN", pAuxiliaryInstance.Caption)
pIsLoaded = True
<font color="#0000A0">End</font> <font color="#0000A0">Sub</font>
<font color="#0000A0">Private</font> <font color="#0000A0">Sub</font> CreateNewOrGetExistingInstance()
<font color="#0000A0">If</font> pAuxiliaryInstance <font color="#0000A0">Is</font> <font color="#0000A0">Nothing</font> <font color="#0000A0">Then</font>
<font color="#0000A0">Set</font> pAuxiliaryInstance = <font color="#0000A0">New</font> Application
<font color="#0000A0">If</font> pAuxiliaryInstance.Workbooks.Count = 0 <font color="#0000A0">And</font> pPersonalXls <> "" <font color="#0000A0">Then</font>
pAuxiliaryInstance.Workbooks.Open pPersonalXls
<font color="#0000A0">End</font> <font color="#0000A0">If</font>
<font color="#0000A0">End</font> <font color="#0000A0">If</font>
<font color="#008000"> 'always set the visiblility to True because the user may have closed</font>
<font color="#008000"> 'the application but it is still running invisibly if we have a reference to it</font>
pAuxiliaryInstance.Visible = True
<font color="#0000A0">End</font> <font color="#0000A0">Sub</font>
<font color="#0000A0">Private</font> <font color="#0000A0">Sub</font> CloseMeAndStartMeInNewInstance()
<font color="#008000"> 'create a VBScript file to reopen this workbook in a new instance</font>
<font color="#008000"> 'get a reference to the correct, existing instance using an</font>
<font color="#008000"> 'arbitrary workbook's fullname</font>
<font color="#0000A0">Dim</font> WshShell <font color="#0000A0">As</font> Object, fso <font color="#0000A0">As</font> FileSystemObject
<font color="#0000A0">Dim</font> TempScriptFilename <font color="#0000A0">As</font> String, FhWnd <font color="#0000A0">As</font> <font color="#0000A0">Integer</font>
<font color="#0000A0">Set</font> fso = CreateObject("Scripting.FileSystemObject")
<font color="#008000"> 'build temp vbscript filename using temp folder and temp filename</font>
TempScriptFilename = fso.GetSpecialFolder(2) & "\" & fso.GetTempName & ".vbs"
<font color="#008000"> 'temp vbscript file</font>
FhWnd = FreeFile
<font color="#0000A0">Open</font> TempScriptFilename <font color="#0000A0">For</font> <font color="#0000A0">Output</font> <font color="#0000A0">As</font> #FhWnd
<font color="#0000A0">Print</font> #FhWnd, "dim wb, auxiliaryinstance, fso, objxl, starttime"
<font color="#0000A0">Print</font> #FhWnd, "set wb = wscript.getobject(" & Chr(34) & ThisWorkbook.FullName & Chr(34) & ")"
<font color="#0000A0">Print</font> #FhWnd, "set auxiliaryinstance = wb.parent"
<font color="#0000A0">Print</font> #FhWnd, "wb.close false"
<font color="#0000A0">Print</font> #FhWnd, "set objxl = wscript.createobject(" & Chr(34) & "excel.application" & Chr(34) & ")"
<font color="#0000A0">Print</font> #FhWnd, "objxl.visible = true"
<font color="#0000A0">Print</font> #FhWnd, "objxl.workbooks.open " & Chr(34) & ThisWorkbook.FullName & Chr(34)
<font color="#0000A0">Print</font> #FhWnd, "on error resume next"
<font color="#0000A0">Print</font> #FhWnd, "set wb = objxl.workbooks(" & Chr(34) & ThisWorkbook.Name & Chr(34) & ")"
<font color="#0000A0">Print</font> #FhWnd, "starttime = now"
<font color="#0000A0">Print</font> #FhWnd, "do until wb.isloaded"
<font color="#0000A0">Print</font> #FhWnd, " set wb = objxl.workbooks(" & Chr(34) & ThisWorkbook.Name & Chr(34) & ")"
<font color="#0000A0">Print</font> #FhWnd, " if datediff(" & Chr(34) & "s" & Chr(34) & ",starttime,now) > 5 then"
<font color="#0000A0">Print</font> #FhWnd, " msgbox " & Chr(34) & "operation timed out or other error..." & Chr(34)
<font color="#0000A0">Print</font> #FhWnd, " wscript.quit"
<font color="#0000A0">Print</font> #FhWnd, " end if"
<font color="#0000A0">Print</font> #FhWnd, "loop"
<font color="#0000A0">Print</font> #FhWnd, "on error goto 0"
<font color="#0000A0">Print</font> #FhWnd, "set wb.auxiliaryinstance = auxiliaryinstance"
<font color="#0000A0">Print</font> #FhWnd, "set fso = createobject(" & Chr(34) & "scripting.filesystemobject" & Chr(34) & ")"
<font color="#0000A0">Print</font> #FhWnd, "fso.deletefile wscript.scriptfullname"
<font color="#0000A0">Close</font> #FhWnd
<font color="#0000A0">Set</font> WshShell = CreateObject("WScript.Shell")
<font color="#008000"> 'run the script to close and reopen this in another instance</font>
<font color="#008000"> 'the script will delete it'self</font>
WshShell.Run TempScriptFilename
<font color="#0000A0">End</font> <font color="#0000A0">Sub</font>
</FONT></td></tr></table>