I'm making a script that uses the dialog box below to select the folder where this run commands the problem is that it is not necessary as an option to create a new folder ... I wonder how can I remove the "make new folder"?
My Code:
Option Explicit
Dim strPath
strPath = SelectFolder( "" )
If strPath = vbNull Then
WScript.Echo "Cancelled"
Else
WScript.Echo "Selected Folder: """ & strPath & """"
End If
Function SelectFolder( myStartFolder )
' Standard housekeeping
Dim objFolder, objItem, objShell
' Custom error handling
On Error Resume Next
SelectFolder = vbNull
' Create a dialog object
Set objShell = CreateObject( "Shell.Application" )
Set objFolder = objShell.BrowseForFolder( 0, "Select Folder", 1, myStartFolder )
' Return the path of the selected folder
If IsObject( objfolder ) Then SelectFolder = objFolder.Self.Path
' Standard housekeeping
Set objFolder = Nothing
Set objshell = Nothing
On Error Goto 0
End Function
When in doubt, read the documentation:
BIF_NONEWFOLDERBUTTON (0x00000200)
0x00000200. Version 6.0. Do not include the New Folder button in the browse dialog box.
Add 0x200 to the options parameter:
Set objFolder = objShell.BrowseForFolder(0, "Select Folder", &h201, myStartFolder)
Related
In continuation of Call VBScript from Windows Explorer Context Menu, I managed to get a VBScript file running from SendTo in the Windows Explorer.
I've changed my code to copy the file that invokes the script to my Temp folder. The new problem is that if the path is over 256 characters, I can't loop through WScript.Arguments to get all of it. Is there another way to get the full path (including the file name and it's extension)?
Option Explicit
Call OpenDocuWorksFile
Sub OpenDocuWorksFile()
Const sTitle = "Open DocuWorks File"
Dim iArgumentsCount
Dim iArgument
Dim sFilePath
Dim sTempFolder
Dim oFileScriptingObject
Dim sFileName
Dim oShell
iArgumentsCount = WScript.Arguments.Count
On Error Resume Next
For iArgument = 0 To iArgumentsCount
sFilePath = sFilePath & WScript.Arguments(iArgument)
Next
On Error GoTo 0
Set oFileScriptingObject = CreateObject("Scripting.FileSystemObject")
With oFileScriptingObject
sFileName = .GetFileName(sFilePath)
sTempFolder = oFileScriptingObject.GetSpecialFolder(2) 'Temp Folder
If .GetExtensionName(sFileName) = "xdw" Then
.CopyFile sFilePath, sTempFolder & "\", True 'Overwrite
Set oShell = CreateObject("Shell.Application")
oShell.Open sTempFolder & "\" & sFileName
Else
MsgBox "Please select a DocuWorks file.（.xdw)", vbCritical, sTitle
End If
End With
Set oFileScriptingObject = Nothing
Set oShell = Nothing
End Sub
I have a working vbscript that creates a group of folders in a directory chosen by the user on a windows 2008 r2 server. I want to modify it to create additional sub-folders within the primary folders being created. I'm googled out and need advice.
Here is the working script:
' 26Apr2015 jkw -- q&d
Option Explicit
Dim g_fso: Set g_fso = CreateObject("Scripting.FileSystemObject")
Dim tgt: tgt = BrowseFolder(".", False)
Dim subdirs: subdirs = Array(_
"Accounting",_
"Anchors",_
"Approvals",_
"Bid Documents",_
"Engineering",_
"Mold Drawings",_
"Plans and Specs",_
"Revisions and Cost Changes",_
"Shops",_
"Transmittals"_
)
Dim subdir
For Each subdir in subdirs
WScript.Echo g_fso.CreateFolder(tgt & "\" & subdir)
Next
Function BrowseFolder( myStartLocation, blnSimpleDialog )
' This function generates a Browse Folder dialog
' and returns the selected folder as a string.
'
' Arguments:
' myStartLocation [string] start folder for dialog, or "My Computer", or
' empty string to open in "Desktop\My Documents"
' blnSimpleDialog [boolean] if False, an additional text field will be
' displayed where the folder can be selected
' by typing the fully qualified path
'
' Returns: [string] the fully qualified path to the selected folder
'
' Based on the Hey Scripting Guys article
' "How Can I Show Users a Dialog Box That Only Lets Them Select Folders?"
' http://www.microsoft.com/technet/scriptcenter/resources/qanda/jun05/hey0617.mspx
'
' Function written by Rob van der Woude
' http://www.robvanderwoude.com
Const MY_COMPUTER = &H11&
Const WINDOW_HANDLE = 0 ' Must ALWAYS be 0
Dim numOptions, objFolder, objFolderItem
Dim objPath, objShell, strPath, strPrompt
' Set the options for the dialog window
strPrompt = "Select a folder in which to create subdirectories:"
If blnSimpleDialog = True Then
numOptions = 0 ' Simple dialog
Else
numOptions = &H10& ' Additional text field to type folder path
End If
' Create a Windows Shell object
Set objShell = CreateObject( "Shell.Application" )
' If specified, convert "My Computer" to a valid
' path for the Windows Shell's BrowseFolder method
If UCase( myStartLocation ) = "MY COMPUTER" Then
Set objFolder = objShell.Namespace( MY_COMPUTER )
Set objFolderItem = objFolder.Self
strPath = objFolderItem.Path
Else
strPath = myStartLocation
End If
Set objFolder = objShell.BrowseForFolder( WINDOW_HANDLE, strPrompt, _
numOptions, strPath )
' Quit if no folder was selected
If objFolder Is Nothing Then
BrowseFolder = ""
Exit Function
End If
' Retrieve the path of the selected folder
Set objFolderItem = objFolder.Self
objPath = objFolderItem.Path
' Return the path of the selected folder
BrowseFolder = objPath
End Function
Any help will be greatly appreciated.
Something like this.
For Each subdir in subdirs
set subdirnew = g_fso.CreateFolder(tgt & "\" & subdir)
'then repeat for your other folders
g_fso.CreateFolder(subdirnew.path & "\" & subsubdir)
Next
You can just add them to your list like so:
Dim subdirs: subdirs = Array(_
"Accounting",_
"Anchors",_
"Approvals",_
"Approvals\NewFolder",_
"Approvals\NewFolder\Something",_
"Approvals\AnotherFolder",_
"Bid Documents",_
"Engineering",_
"Mold Drawings",_
"Plans and Specs",_
"Revisions and Cost Changes",_
"Shops",_
"Transmittals"_
)
Just make sure they are in order for example you cannot have Approvals\NewFolder\Something before Approvals\NewFolder as Approvals\NewFolder will not be created yet.
Set fso = CreateObject("Scripting.FileSystemObject")
Set objFolder = fso.GetFolder("C:\New folder _1")
I am using this code to read the folderpath. objFolder will store the path of the folder.
In the same way, when i run the total code, i need to get a dialogue box where
i should be able to enter the folderpath.
This script to Browse4File : browse files in folder
and this code for Browse4Folder :
Option Explicit
Dim RootFolder
RootFolder = Browse4Folder
MsgBox RootFolder,VbInformation,RootFolder
'**********************************************************************************************
Function Browse4Folder()
Dim objShell,objFolder,Message
Message = "Please select a folder in order to scan into it and its subfolders"
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(0,Message,1,"c:\Programs")
If objFolder Is Nothing Then
Wscript.Quit
End If
Browse4Folder = objFolder.self.path
end Function
'**********************************************************************************************
Long time searcher, 1st time poster.
I have put together a vb script my users can run from explorer that will allow them to create and name a new folder and then robocopy a template structure into the new folder. I used robocopy so the intricate folder permissions would copy with the template, which is the main motivation behind the script.
I am by no means an expert with vb. So happy to here any advise on this Script, but this script works nicely for the users.....so far anyway!!!
SetobjShell = CreateObject("Wscript.Shell")
Call Entercompanyname
Function Entercompanyname
companyname = InputBox("Please enter the new company name" & vbLf & "(or select cancel to it)", _
"Create New Company Folder")
If IsEmpty(companyname) Then
Cancel = MsgBox("Are you sure you want to exit ?", 68, "Exit Application?")
If Cancel = vbYes Then
WScript.Quit
ElseIf Cancel = vbNo Then
Call Entercompanyname
End If
ElseIf Len(companyname) = 0 Then
MsgBox "You clicked OK but did not enter a new company name", 64, "Error: No Company Name entered"
Call Entercompanyname
End If
objSource = "\\serverxx\Data\Accounts\Accounting\company_template"
objDestination = ("\\serverxx\Data\Accounts\Accounting\" & companyname)
objCommand = "RoboCopy.Exe " & Chr(34) & objSource & Chr(34) & " " & Chr(34) & objDestination & Chr(34) & " /sec /e /r:1 /w:2"
objShell.Run(objCommand)
Now the department head has come back to me and asked for a new script to be able to create new year folder in each of the company names. We will have a template for the new year, but they want to be able to choose which companies the new year folder gets created.
Has anyone got any advise.
Thanks in advance!!
I have been asked for an example. I have found this, which is sort of what I am chasing, but this only lets the user select one company. So the process would need to be repeated, which I know will cause dramas
WScript.Echo BrowseFolder( "\\serverxx\Data\Accounts\Accounting", True )
Function BrowseFolder( myStartLocation, blnSimpleDialog )
Const MY_COMPUTER = &H11&
Const WINDOW_HANDLE = 0 ' Must ALWAYS be 0
Dim numOptions, objFolder, objFolderItem
Dim objPath, objShell, strPath, strPrompt
strPrompt = "Select a folder:"
If blnSimpleDialog = True Then
numOptions = 0 ' Simple dialog
Else
numOptions = &H10&
End If
Set objShell = CreateObject( "Shell.Application" )
If UCase( myStartLocation ) = "MY COMPUTER" Then
Set objFolder = objShell.Namespace( MY_COMPUTER )
Set objFolderItem = objFolder.Self
strPath = objFolderItem.Path
Else
strPath = myStartLocation
End If
Set objFolder = objShell.BrowseForFolder( WINDOW_HANDLE, strPrompt, _
numOptions, strPath )
If objFolder Is Nothing Then
BrowseFolder = ""
Exit Function
End If
Set objFolderItem = objFolder.Self
objPath = objFolderItem.Path
End Function
So I have the following code to wrap the Shell.Application.BrowseForFolder() method. It's adapted from http://blogs.technet.com/b/heyscriptingguy/archive/2005/06/17/how-can-i-show-users-a-dialog-box-that-only-lets-them-select-folders.aspx:
Function BrowseFolder( myStartLocation, blnSimpleDialog, strPrompt )
Const MY_COMPUTER = &H11&
Const WINDOW_HANDLE = 0 ' Must ALWAYS be 0
Dim numOptions, objFolder, objFolderItem
Dim objPath, objShell, strPath ', strPrompt
' Set the options for the dialog window
'strPrompt = "Select a folder:"
If blnSimpleDialog = True Then
numOptions = 0 ' Simple dialog
Else
numOptions = &H10& ' Additional text field to type folder path
End If
' Create a Windows Shell object
Set objShell = CreateObject( "Shell.Application" )
' If specified, convert "My Computer" to a valid
' path for the Windows Shell's BrowseFolder method
If UCase( myStartLocation ) = "MY COMPUTER" Then
Set objFolder = objShell.Namespace( MY_COMPUTER )
Set objFolderItem = objFolder.Self
strPath = objFolderItem.Path
Else
strPath = myStartLocation
End If
Set objFolder = objShell.BrowseForFolder( WINDOW_HANDLE, strPrompt, _
numOptions, strPath )
' Quit if no folder was selected
If objFolder Is Nothing Then
BrowseFolder = ""
Exit Function
End If
' Retrieve the path of the selected folder
Set objFolderItem = objFolder.Self
objPath = objFolderItem.Path
' Return the path of the selected folder
BrowseFolder = objPath
End Function
Here is the code that calls it:
Function GetSLOCDir()
Dim FSO
Dim slocDir
Dim cwd
Set FSO = GetFSO()
slocDir = ""
While (slocDir="" OR NOT FSO.FolderExists(slocDir))
cwd = FSO.GetAbsolutePathName(".")
slocDir = BrowseFolder(cwd, True, "Select the SLOC Directory.")
WScript.Echo "slocDir: " & slocDir
If (slocDir="") Then
WScript.Echo "Aborted."
WScript.Quit
End If
WEnd
GetSLOCDir = slocDir
End Function
The first time through the loop, the browse dialog is displayed. If I click "Make New Folder", it creates a new folder, allowing me to type a folder name. But when I press enter, it goes back to saying "New Folder", but on the filesystem it renames it correctly. However, the BrowseFolder() function returns "New Folder", which causes the loop to iterate. The new browse dialog shows the correct folder name, which I can then select.
However this seems clunky. Is this a bug in the BrowseForFolder method?
Thanks
I am sorry for my English first.
You can run this script using cscript.exe or 64bit-Version of wscript.exe.
32bit Version has this bug.