Solved

VB Advanced browse Full path name for file with spaces

Posted on 2004-10-19
7
380 Views
Last Modified: 2013-12-26
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
0
Comment
Question by:mlacaille
  • 2
7 Comments
 
LVL 48

Expert Comment

by:Mikal613
ID: 12362797
what exactly do you want?
0
 
LVL 14

Expert Comment

by:Shiju Sasidharan
ID: 12363450
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
0
 

Author Comment

by:mlacaille
ID: 12370490
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.
0
 
LVL 14

Accepted Solution

by:
Shiju Sasidharan earned 400 total points
ID: 12387342
hi

why dont u use Common Dialogue Control to Open the file, it will return the complete path including White space.
after getting this path , u can use File System objects or normal file functions to write that into a file( as ur requirement)
'-------------------------------------------------------

'Place a Microsoft Common Dialoge Control in ur Project
' Change its name to cmmDlg
'-----------------------------------------------------------------
Private Sub Command1_Click()
  Dim sPath as String
    cmmDlg.FileName = ""
    cmmDlg.DialogTitle = "Please Select a pts File"
    cmmDlg.Filter = "Pts (*.pts) | *.pts"
    cmmDlg.ShowOpen
    sPath = cmmDlg.FileName
    If sPath ="" Then
          MsgBox "File Not Selected"
   Else
        MsgBox "Selected File :   " & sPath
  End If
End Sub
'------------------------------------------------------------

;-)
Shiju
0

Featured Post

How to improve team productivity

Quip adds documents, spreadsheets, and tasklists to your Slack experience
- Elevate ideas to Quip docs
- Share Quip docs in Slack
- Get notified of changes to your docs
- Available on iOS/Android/Desktop/Web
- Online/Offline

Join & Write a Comment

Have you ever wanted to restrict the users input in a textbox to numbers, and while doing that make sure that they can't 'cheat' by pasting in non-numeric text? Of course you can do that with code you write yourself but it's tedious and error-prone …
You can of course define an array to hold data that is of a particular type like an array of Strings to hold customer names or an array of Doubles to hold customer sales, but what do you do if you want to coordinate that data? This article describes…
Show developers how to use a criteria form to limit the data that appears on an Access report. It is a common requirement that users can specify the criteria for a report at runtime. The easiest way to accomplish this is using a criteria form that a…
This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This l…

708 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

18 Experts available now in Live!

Get 1:1 Help Now