Link to companion file works only once

XLS Padlock
1

Hello,

in Excel 2013 Professional Plus my links to companion files work only once. When I close the file and want to reopen it I get this error message:

error message

I think, setoption helper didn’t work. What can I do? Can you help me? Thank you very much.

Here is my code:

Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)
Dim b As Byte
Dim TextE As String
Dim wbk As Workbook

On Error Resume Next

Application.ScreenUpdating = False

TextE = "Bitte erst die Ergebnisübersicht schließen."

Workbooks("Mathe-Wolli.xlsb").Sheets(1).Range("openFile_Name").value = ""

If ActiveSheet.ProtectContents = True Then
    For Each wbk In Workbooks
        If wbk.Name Like "*.xls*" And wbk.Name <> "139.xlsb" And wbk.Name <> ActiveWorkbook.Name And wbk.Name <> "Mathe-Wolli.xlsb" Then
            Workbooks("Mathe-Wolli.xlsb").Sheets(1).Range("openFile_Name").value = wbk.Name
            Exit For
        End If
    Next
    
End If

If ActiveSheet.Range("EUE_offen").value = "Wahr" Then
    MsgBox TextE, vbCritical, "Mathe-Wolli"
    Call AktivierenEUE
    Exit Sub
ElseIf ActiveSheet.Range("AufgabeOffen").value <> "Falsch" Then
    MsgBox "Bitte erst """ & Range("AufgabeOffen").value & """ schließen.", vbCritical, "Mathe-Wolli"
    Call AktivierenAufgabe
    Exit Sub
ElseIf Workbooks("Mathe-Wolli.xlsb").Sheets(1).Range("openFile_Name").value <> "" Then
    Call AktivierenDatei
    Exit Sub
End If


'Padlock
Dim XLSPadlock As Object
Set XLSPadlock = Application.COMAddIns("GXLS.GXLSPLock").Object
XLSPadlock.SetOption option:="2", value:="0"
XLSPadlock.SetOption option:="1", value:="1"

'the companion file    
If Target.Range.Address = Cells(3, 1).Address Then
    Workbooks.Open (PathToCompiledFile("Mathe-Wolli-Zah.xlsb")), ReadOnly:=True

'no companion file   
ElseIf Target.Range.Address = Cells(8, 5).Address Then
    Workbooks.Open (PathToFile("Mathe-Wolli-Ergebnisse\" & Workbooks("Mathe-Wolli.xlsb").Sheets(1).Range("Anmeldung").value)), UpdateLinks:=False
        
    On Error Resume Next
    XLSPadlock.SetOption option:="2", value:="1"
    XLSPadlock.SetOption option:="1", value:="0"

    For b = 1 To Workbooks.Count
        If Workbooks(b).Name = Workbooks("Mathe-Wolli.xlsb").Sheets(1).Range("Anmeldung").value Then
            Workbooks("Mathe-Wolli.xlsb").Sheets(1).Range("EUE_offen").value = "Wahr"
            Exit For
        End If
    Next b
    
    If Workbooks("Mathe-Wolli.xlsb").Sheets(1).Range("EUE_offen").value = "Falsch" Then
        MsgBox "Die Ergebnisübersicht konnte nicht geöffnet werden.", vbCritical, "Mathe-Wolli"
        Exit Sub
    End If
End If

'Padlock
If Target.Range.Address <> Cells(8, 5).Address Then
    On Error Resume Next
    XLSPadlock.SetOption option:="2", value:="1"
    XLSPadlock.SetOption option:="1", value:="0"
End If

Application.ScreenUpdating = True

End Sub
2

Try to remove

to see whether there is no error inside your code.