Kommandolinie og opstart af projektmappe

Hej

Jeg har i en projektmappe oprettet en kommandolinie som "popper op" når projektmappen åbnes. Fra en "knap" i kommandolinien skal nedenstående vba køres der gør (burde gøre) følgende:

1) Checke om der en projektmappe navngivet med cpr.nr i  (D7)
2) Se i angivne sti om projektmappen findes (med endelsen .obs)
3) Checke om projektmappen allerede er åben og i givet fald aktivere den - ellers åbne den.

Problemet er blot at intet sker - jeg har med andre ord lavet fejl jeg pt ikke helt kan gennemskue?

Mon der skulle være hjælp at hente?

vh Steen


Function WorkbookOpen(WorkBookName As String) As Boolean
' returns TRUE if the workbook is open
    WorkbookOpen = False
    On Error GoTo WorkBookNotOpen
    If Len(Application.Workbooks(WorkBookName).Name) > 0 Then
        WorkbookOpen = True
        Exit Function
    End If
WorkBookNotOpen:
End Function



Sub ÅbenObservationsskema()
Dim sPath As String, wb As Workbook

On Error Resume Next

If Range("D7") = "" Then

MsgBox ("Cpr nummer SKAL indtastes")
    sPath = "\\hjertesrv\faelles\Index data\Observationsskemaer\"
    If Dir(sPath & Range("D7") & ".obs") <> "" Then
            If Not WorkbookOpen(sPath & Range("D7") & ".obs") Then
                Workbooks.Open sPath & Range("D7") & ".obs"
   
            Else:
            Windows(sPath & Range("D7") & ".obs").Activate
           
            End If
       
    Else:
        MsgBox ("Patientmappen er ikke oprettet")
   
    End If

End If

End Sub