Search and open feature

The pictures speak for themselves:

\1

\1

I already tried to fix this using the following macro but no success

Sub OpenWorkbook()
Dim s1 as String, bk as Workbook, bk1 as Workbook
s1 = "C:\Documents and Settings\" & _
"fackt0\Desktop\Shipments\"

set bk = activeWorkbook
if dir(s1 & Range("C3").Text & ".xls") <> "" then
set bk1 = Workbooks.Open(s1 & Range("J5").Text & ".xls")
bk.Activate
else
msgbox "workbook not found"
End if
End sub

Anyone with an idea what might be wrong?