Wo ist der Fehler "Subscipten out of Range"

Sub CheckTheColumns(WorkbookName)
Dim books, strExt, ZuÖffnendeDatei, strPath, book As String
Dim pfad As String
Dim Workbook As String
Workbook = Right(WorkbookName, Len(WorkbookName) - InStrRev(WorkbookName, "\", -1))
Workbooks(Workbook).Activate
'Workbooks(WorkbookName).Worksheets("Summary").Cells(2).Rows(1) = ""
If books = "" Then
MsgBox "You haven´t opened the Datafile who are the Datas for the Makro"
strExt = "*.xls"       'Dateiextension ggf. anpassen
ZuÖffnendeDatei = Application.GetOpenFilename("Exceldateien (" & strExt & "), " & strExt)
If ZuÖffnendeDatei = False Then Exit Sub
strPath = CurDir
If strPath = "" Then
Exit Sub
Else
ChDir strPath
Workbooks.OpenText FileName:=ZuÖffnendeDatei
pfad = ZuÖffnendeDatei
ActiveWorkbook.Worksheets("Summary").Cells(2).Rows(1) = Right(pfad, Len(pfad) - InStrRev(pfad, "\", -1))
End Sub