VBS Dateiauswahl klappt nicht bei jeder Endung (ShellApp.BrowseForFolder)

  Dim ShellApp, Ret, s, i
 Set ShellApp = CreateObject("Shell.Application")  
 
 On Error Resume Next
 Set Ret = ShellApp.BrowseForFolder(0, "Bitte wählen Sie die Datei aus, die Sie übertragen möchten:", 16384)  
 s = Ret.title
 If Err.number <> 0 Then
 WScript.Quit
 End If
 
 s = GetPath(Ret, i)
 MsgBox s
  
 Function GetPath(Fil, iItem)
 Dim Pt1, fPar, sn, Obj, sType
 On Error Resume Next
 sn = Fil.title
 MsgBox "sn (File/Folder title): " &sn  
 Set fPar = Fil.parentfolder
 MsgBox "fPar (File/Folder parent Folder): " &fpar  
 
 Set Obj = fPar.parsename(sn) '--return item selected as a Shell FolderItem.  
 MsgBox "Obj (return item selected as a Shell FolderItem): " &obj  
 
 '--weed out namespaces and drives. If it's a namespace or drive it can't  
 '--return a FolderItem so the last Call caused an error and Obj is therefore  
 '--Not part of the filesystem:  
 
 If Obj.isfilesystem = false Then
 Pt1 = instr(sn, ":")  
 If Pt1 = 0 Then
 iItem = 0  '--namespace.  
 getpath = sn
 Else
 iItem = 1 '--drive.  
 getpath = mid(sn, (Pt1 - 1), 2) & "\"  '--Get letter before : and add "\" If drive.  
 End If
 Set Obj = nothing
 exit Function
 End If
 
 '--it's a file or folder. find out which and Get path:  
 sType = Obj.type  '--Get object Type as shown in folder Details view.  
 MsgBox "sType (Get object Type as shown in folder Details view): " &sType '-- Should be able to use: If Obj.IsFolder = True..... but it doesn't work.  
 
 If instr(sType, "Bestandsmap") = 0 Then  '-TAALGEVOELIG-in detail view a folder will be type "File Folder".  
 iItem = 3  '--file.  
 Else
 iItem = 2  '--folder.  
 End If
 
 getpath = Obj.path
 Set Obj = Nothing
 End Function