Option Explicit
Sub checkFileOpenViaScriptingRuntime()
Dim fso As Object
Dim sPath As String, sFile As String, sFullPath As String
sFile = "MeineExcel.xlsm"
sPath = "PfadMeinerExcel\"
sFullPath = sPath & "~$" & sFile
With CreateObject("Scripting.FileSystemObject")
Call GetOrSetObject
End With
End Sub
Sub GetOrSetObject()
Dim xlApp As Excel.Application
On Error GoTo FinishErr
Set xlApp = GetObject(class:="Excel.Application")
If xlApp.ActiveWorkbook.Name = "MeineExcel.xlsm" Then
xlApp.Visible = True
xlApp.Quit
FinishErr:
Select Case Err.Number
Case 0
Case 429
Set xlApp = New Excel.Application
Resume Next
Case Else
MsgBox Err.Number & vbCr & Err.Description, vbCritical, "Autor informiert:"
End Select
Set xlApp = Nothing
End If
End Sub