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
'**********************************************************************************************
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 2 scripts but could not combine them
'create multiple folders script:
Dim objFSO, objFolder, strDirectory, i
strDirectory = "C:\Users\test\Desktop\"
Set objFSO = CreateObject("Scripting.FileSystemObject")
i = 1 ''
While i < 150
Set objFolder = objFSO.CreateFolder(strDirectory & i)
i = i+1
''WScript.Quit ''
Wend
'desktop path script
set WshShell = WScript.CreateObject("WScript.Shell")
strDesktop = WshShell.SpecialFolders("Desktop")
wscript.echo(strDesktop)
I want the code to automatically find the desktop path and then create the folders, some one help me please ?
To get the desktop folder path string and create a sub directory you can do this:
Set objShell = Wscript.CreateObject("Wscript.Shell")
strPath = objShell.SpecialFolders("Desktop")
Dim objFso
Set objFso = WScript.CreateObject("Scripting.FileSystemObject")
If Not objFso.FolderExists(strPath + "\NewFolder") Then
objFso.CreateFolder strPath + "\NewFolder"
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)
I've got the following code to display a directory chooser dialog
Function selectOutputFolder(lastPath As String) As String
Const BIF_NEWDIALOGSTYLE = &H00000040
Dim objShell As Variant
Dim objFolder As Variant
Dim objFolderItem As Variant
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(0, "Choose a directory", BIF_NEWDIALOGSTYLE, lastPath)
If Not (objFolder Is Nothing) Then
Set objFolderItem = objFolder.Self
selectOutputFolder = objFolderItem.Path
End If
End Function
I was playing around with the 4th parameter of BrowseForFolder which is only a limit for the directory traversal and not to jump into this folder on open.
This is implemented into a lotus script agent, so if you know any alternative in vba or lotusscript, let me know!
There is a "Standard" way to do this in LotusScript by using the SaveFileDialog- Method of the NotesUIWorkspace- Class.
'...your sub goes around this
Dim ws as New NotesUIWorkspace
Dim varPaths as Variant
varPaths = ws.SaveFileDialog( True , "Choose file" , "" , lastPath )
If not isEmpty( varPaths ) then
selectOutputFolder = varPaths(0)
End If
I never did any vbscript before, so i don't know if my question is very easy one. Following is the flow of steps that has to be done :
Check if exist and delete a folder at c:\test1 if found and continue. If not found continue.
Check if exist and delete a folder at c:\programfiles\test2 if found and continue. If not found continue.
Check if a desktop shortcut and start menu shortcut exist and delete if found. If not exit.
I could delete 2 folders with the following code:
strPath1 = "C:\test1"
strPath1 = "C:\test1"
DeleteFolder strPath1
DeleteFolder strPath1
Function DeleteFolder(strFolderPath1)
Dim objFSO, objFolder
Set objFSO = CreateObject ("Scripting.FileSystemObject")
If objFSO.FolderExists(strFolderPath) Then
objFSO.DeleteFolder strFolderPath, True
End If
Set objFSO = Nothing
But i need to run one script to delete 2 folders in different paths, 2 shortcuts one in start menu and one on desktop.
I was experimenting with this code to delete the shortcut on my desktop:
Dim WSHShell, DesktopPath
Set WSHShell = WScript.CreateObject("WScript.Shell")
DesktopPath = WSHShell.SpecialFolders("Desktop")
on error resume next
Icon = DesktopPath & "\sample.txt"
Set fs = CreateObject("Scripting.FileSystemObject")
Set A = fs.GetFile(Icon)
A.Delete
WScript.Quit
It works fine for txt file on desktop, but how do i delete a shortcut for an application from desktop as well as start menu.
strPath1 = "C:\test1"
strPath2 = "C:\test2"
DeleteFolder strPath1
DeleteFolder strPath2
DeleteShortcut
'-------------------------------------------------------
Sub DeleteFolder(strFolderPath)
Set fso = CreateObject ("Scripting.FileSystemObject")
If fso.FolderExists(strFolderPath) Then
fso.DeleteFolder strFolderPath, True
End If
End Sub
'-------------------------------------------------------
Sub DeleteShortcut()
Set WSHShell = WScript.CreateObject("WScript.Shell")
DesktopPath = WSHShell.SpecialFolders("Desktop")
shortcutPath = DesktopPath & "\MyShortcut.lnk"
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FileExists(shortcutPath) Then
Set myFile = fso.GetFile(shortcutPath)
myFile.Delete
End If
End Sub