Link to home
Start Free TrialLog in
Avatar of mlacaille
mlacaille

asked on

VB Advanced browse Full path name for file with spaces

I'm trying to write a script that will promt a browse windows and will return the full path (with space) of a file so I can use it in my script to compare another file. Cant get the script to work because there is some spaces in the path name.

It tried adding value to get it to work but with no succes.

Help

ML

'-- Hwnd is always 0. Title is browse window caption. RootFolder is optional top folder to show.
'-- Options has several possibilities:
'--   1 - only allows selection of system folders. (doesn't seem to work.)
'--   2 - don't show network folders below domain level. (doesn't work on stand-alone system.)
'--   8 - only allow selection of File System ancestors(??) (on stand-alone system nothing can be selected.)
'--  16 - adds a text input but only valid entries will be returned; cannot create a folder.
'--  4096 - only computers can be selected.
'--  8192 - only a printer can be selected.
'--  16384 - full browsing, includes files.
'--  This script uses the FolderItems object properties to Get path and
'--   find out what type of item it is.

'---------------------------------------------------------

Dim ShellApp, Ret, s, i
Set ShellApp = CreateObject("Shell.Application")

 On Error Resume Next
Set Ret = ShellApp.BrowseForFolder(0, "Choose file.", 16384)
 s = Ret.title
  If Err.number <> 0 Then
     WScript.Quit
  End If  

    s = GetPath(Ret, i)
    MsgBox s & "-" & cstr(i)  '--show full path and type of item returned. 0-namespace. 1-drive. 2-folder. 3-file.
    Set ShellApp = nothing
    WScript.Quit

   
   
 Function GetPath(Fil, iItem)  
   Dim Pt1, fPar, sn, Obj, sType
       On Error Resume Next
          sn = Fil.title
         Set fPar = Fil.parentfolder
       
      Set Obj = fPar.parsename(sn) '--return item selected as a Shell FolderItem.
     
       '--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.
                           '-- Should be able to use: If Obj.IsFolder = True..... but it doesn't work.
               
         If instr(sType, "Folder") = 0 Then  '--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
Avatar of Mikal613
Mikal613
Flag of United States of America image

what exactly do you want?
hi
Put the following code in a module
'================================
Option Explicit
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As String) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" _
                              (ByVal pIdl As Long, ByVal pszPath As String) As Long
Private Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" _
                              (ByVal hwndOwner As Long, ByVal nFolder As Long, _
                              pIdl As ITEMIDLIST) As Long
Private Const NOERROR = 0
Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal pv As Long)
Private Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" _
                              (lpBrowseInfo As BROWSEINFO) As Long ' ITEMIDLIST

Type SHITEMID
    cb As Long
    abID() As Byte
End Type
Type ITEMIDLIST
    mkid As SHITEMID
End Type
Public Const MAX_PATH = 260
Private Const WM_USER = &H400
Private Const BFFM_INITIALIZED = 1
Private Const BFFM_SELCHANGED = 2
Private Const BFFM_SETSTATUSTEXT = (WM_USER + 100)
Private Const BFFM_SETSELECTION = (WM_USER + 102)
Private gsCurrentDirectory As String
Public Type BROWSEINFO
    hOwner As Long
    pidlRoot As Long
    pszDisplayName As String
    lpszTitle As String
    ulFlags As Long
    lpfn As Long
    lParam As Long
    iImage As Long
End Type
Public Enum Root_Folder
    SHOW_DESKTOP = &H0
    SHOW_PROGRAMS = &H2
    SHOW_CONTROLS = &H3
    SHOW_PRINTERS = &H4
    SHOW_PERSONAL = &H5
    SHOW_FAVORITES = &H6
    SHOW_STARTUP = &H7
    SHOW_RECENT = &H8
    SHOW_SENDTO = &H9
    SHOW_RECYCLE_BIN = &HA
    SHOW_STARTMENU = &HB
    SHOW_DESKTOPDIRECTORY = &H10
    SHOW_DRIVES = &H11
    SHOW_NETWORK = &H12
    SHOW_NETHOOD = &H13
    SHOW_FONTS = &H14
    SHOW_TEMPLATES = &H15
    SHOW_COMMON_STARTMENU = &H16
    SHOW_COMMON_PROGRAMS = &H17
    SHOW_COMMON_STARTUP = &H18
    SHOW_COMMON_DESKTOPDIRECTORY = &H19
    SHOW_APPDATA = &H1A
    SHOW_PRINTHOOD = &H1B
End Enum

Public Enum Return_From
    BIF_RETURNONLYFSDIRS = &H1 '// Browse for directory
    BIF_DONTGOBELOWDOMAIN = &H2    '// For starting the Find Computer
    BIF_STATUSTEXT = &H4
    BIF_RETURNFSANCESTORS = &H8
    BIF_EDITBOX = &H10    '16
    BIF_BROWSEFORCOMPUTER = &H1000 '4096     '// Browse for computer
    BIF_BROWSEFORPRINTER = &H2000 '8192  '// Browse for printers
    BIF_BROWSEINCLUDEFILES = &H4000 '16384   '// Browse for everything
    BIF_NEWDIALOGSTYLE = &H40 '//To create New Folder Option
End Enum
Public Enum Return_Type
  ReturnPath = 0
  ReturnName = 1
End Enum
Public Function BrowShow(ByVal hwnd As Long, Optional RootFolder As Root_Folder, Optional ReturnFrom As Return_From, Optional ReturnType As Return_Type, Optional sTitle As String, Optional sStartDirectory As String) As String
    Dim BI As BROWSEINFO
    Dim IDL As ITEMIDLIST
    Dim nFolder As Long
    Dim pIdl As Long
    Dim sPath As String
    BrowShow = ""
    gsCurrentDirectory = sStartDirectory & vbNullChar
    With BI
        .hOwner = hwnd
        nFolder = RootFolder
        If SHGetSpecialFolderLocation(ByVal hwnd, ByVal nFolder, IDL) = NOERROR Then
          .pidlRoot = IDL.mkid.cb
        End If
        .pszDisplayName = String$(MAX_PATH, 0)
        If Trim(sTitle) = "" Then
            .lpszTitle = "Please Select Destination Path"
        Else
            .lpszTitle = sTitle
        End If
        .ulFlags = ReturnFrom
        .lpfn = GetAddressofFunction(AddressOf BrowseCallbackProc)
    End With
    pIdl = SHBrowseForFolder(BI)
    If pIdl = 0 Then Exit Function
    sPath = String$(MAX_PATH, 0)
    SHGetPathFromIDList ByVal pIdl, ByVal sPath
    CoTaskMemFree pIdl
     If ReturnType = 0 Then
      BrowShow = Left(sPath, InStr(sPath, vbNullChar) - 1)
    Else
      BrowShow = Left$(BI.pszDisplayName, InStr(BI.pszDisplayName, vbNullChar) - 1)
    End If
End Function

Private Function GetAddressofFunction(Add As Long) As Long
  GetAddressofFunction = Add
End Function

Public Function BrowseCallbackProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal lp As Long, ByVal pData As Long) As Long
 
  Dim lpIDList As Long
  Dim ret As Long
  Dim sBuffer As String
 
  On Error Resume Next
     
  Select Case uMsg
 
    Case BFFM_INITIALIZED
      Call SendMessage(hwnd, BFFM_SETSELECTION, 1, gsCurrentDirectory)
     
    Case BFFM_SELCHANGED
      sBuffer = Space(MAX_PATH)
     
      ret = SHGetPathFromIDList(lp, sBuffer)
      If ret = 1 Then
        Call SendMessage(hwnd, BFFM_SETSTATUSTEXT, 0, sBuffer)
      End If
     
  End Select
 
  BrowseCallbackProc = 0
End Function
'=========================================================

' And make use of the function call BrowShow with different types of arguments

'-----------------------------------------------------------
Private Sub Command1_Click()
    Dim sPath As String
   
    sPath = BrowShow(hwnd, , BIF_EDITBOX, ReturnPath)
    MsgBox sPath
End Sub
'-----------------------------------------

;-)
Shiju
Avatar of mlacaille
mlacaille

ASKER

I whant to run a existing script in wich I need to select a .pts file then get the path name (with spaces) and write that to into a file.
ASKER CERTIFIED SOLUTION
Avatar of Shiju S
Shiju S
Flag of United States of America image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial