VBScript - BrowseForFolder()

[Mick from CNC Software Inc.]

Guys,

 

I have edited this function to make it a little more reliable. It now seems to work as I would want it by returning an empty string when a user cancels out of the dialog or selects an invalid folder. If you find anything else feel free to edit it.

code:

---

' -- Start Script

Call Main()

 

' ////////////////////

' Sub Declaration

' ////////////////////

Sub Main()

 

Dim strPath, strMCAM9

 

strMCAM9 = GetPath

 

' -- Prompt user for a folder containing dxf files

strPath = BrowseForFolder("Choose a folder....", strMCAM9)

 

If strPath = vbNullString Then

ShowString "Invalid folder selected OR user cancelled"

Else

ShowString "Selected folder:" & vbCrLf & strPath

End If

 

End Sub

 

' //////////////////////////////////////////

' Function Declaration

' Returns vbNullString if no folder selected

' //////////////////////////////////////////

 

Function BrowseForFolder(strPrompt, sFolder)

 

On Error Resume Next

 

Dim objShell, objFolder, intColonPos, objWshShell

Dim FSO, varTemp

 

' -- Create our all important objects

Set objWshShell = CreateObject("WScript.Shell")

Set objShell = CreateObject("Shell.Application")

Set FSO = CreateObject("Scripting.FileSystemObject")

 

Set objFolder = objShell.BrowseForFolder(&H0&, strPrompt, &H1&, sFolder)

 

' -- Initialize to failure

BrowseForFolder = vbNullString

 

' -- Did the user Cancel?

If Not objFolder Is Nothing Then

 

Select Case objFolder.Title

 

' -- Did the user select Desktop?

Case "Desktop"

BrowseForFolder = objWshShell.SpecialFolders("Desktop")

 

Case Else

' -- Get the folder selected

varTemp = objFolder.ParentFolder.ParseName(objFolder.Title).Path

 

' -- If the user does not select a folder or selects root an error is raised

If Err Then

 

Select Case Err.Number

' -- Probably root drive selected e.g. (C:)

Case 91, 424

' -- Check for Root

intColonPos = InStr(objFolder.Title, ":")

 

If intColonPos > 0 Then

BrowseForFolder = Mid(objFolder.Title, intColonPos - 1, 2) & ""

End If

 

Case Else

 

End Select

 

Err.Clear

 

Else

' -- If we get this far make sure the folder exists

' -- selecting a network folder may result in an invalid folder

If FSO.FolderExists(varTemp) Then BrowseForFolder = varTemp

End If

 

End Select

End If

 

' -- Check for an error of any kind

If Err Then

BrowseForFolder = vbNullString

MsgBox "Error selecting folder: " & Err.Description, vbExclamation, "BrowseForFolder"

Exit Function

End If

 

' -- Clean up

Set objWshShell = Nothing

Set objShell = Nothing

Set objFolder = Nothing

Set FSO = Nothing

 

 

 

End Function

---

[Rekd™]

Mick, thanks!

 

One thing I noticed, when it pre-selects Mcam91 folder, you can't access higher level folders.

 

'Rekd

[crazy^millman]

So deso tihs work good with the Mulit_post in keep in from not erroring out if you do this.

 

Thanks Mick Will give it a try and see what it does.

 

Crazy Millman

[Rekd™]

Yes, Millman, it will tell you that you cancelled or selected an invalid folder. (You can suppress the warnings if you like)

 

'Rekd

[crazy^millman]

Thanks and dont tell anyone but I might have got my point across and could be getting a VF4SS with bells and whistles I know it is not a Makino but any step in the right direction is a victory in my book. So I might need your help getting a post dialed in Rekd plus I think you would get a kivk out of seeing one run. It will also have a 4th axis on it.

 

 

Crazy Millman fingers crossed.

[Rekd™]

Lemme know, I'll hook you da f up!

 

'Rekd

[crazy^millman]

Yeah I figured that and if I can hook up up with copies of my post you let me know I burn you a cd of all I got even my 5th axis so you got one incase you ever get to that point one day.

 

Crazy Millman