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.Applic ation")
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
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.Applic
On Error Resume Next
Set Ret = ShellApp.BrowseForFolder(0
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
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_DESKTOPDIRECTO RY = &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(Addre ssOf 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
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
(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_DESKTOPDIRECTO
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
.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(Addre
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
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
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.