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
Related
I have a directory of files that I want to Loop through and use part of their filename to replace text in a template doc.
For example one filename may be 'NV_AD32_city.dxf'. All files in the directory follow the same filename pattern of XX_XXXX_string.dxf, using two underscores.
I need to capture the string to the right of the first "_" and to the left of the "."so for this example that would be 'AD32_city'
How do I script to use capture that text of the active file to replace text in the template? I guess I need to create an object? But what is the object to use for the current file from a directory?
+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Thx for the replies, guys. After several days of trying your code I am just not "getting it". I understand it is set up to take the part of the filename's string that I want but how do I tell the script to use the current file I am looping through? Here is my script so far. I have your code on line 20 under the Sub 'GetNewInputs'
Set fso = CreateObject("Scripting.FileSystemObject")
Option Explicit
Dim WritePath : WritePath = "S:\TempFolder\"
Dim OutFile : OutFile = "VEG_DXF-2-SHP_script-"
Dim WorkingFile : WorkingFile = GetFileContent(SelectFile())
Dim NewState, NewSection, NewArea
Dim OldState, OldSection, OldArea
Call GetNewInputs()
Call GetOldInputs()
Sub GetNewInputs()
NewState = UCase(InputBox("INPUT STATE:", _
"INPUT STATE", "SOCAL"))
NewSection = ("Section_" & InputBox("INPUT SECTION NUMBER:", _
"INPUT SECTION", "14"))
NewArea = "^[^_]+_(.*)\.dxf$"
End Sub
Private Sub GetOldInputs()
OldState = "XX"
OldSection = "_X"
OldArea = "ZZZZ"
End Sub
Function SelectFile()
SelectFile = vbNullString
Dim objShell : Set objShell = WScript.CreateObject("WScript.Shell")
Dim strMSHTA : strMSHTA = "mshta.exe ""about:" & "<" & "input type=file id=FILE>" _
&"<" & "script>FILE.click();new ActiveXObject('Scripting.FileSystemObject')" _
&".GetStandardStream(1).WriteLine(FILE.value);close();resizeTo(0,0);" & "<" & "/script>"""
SelectFile = objShell.Exec(strMSHTA).StdOut.ReadLine()
If SelectFile = vbNullString Then
WScript.Echo "No file selected or not a text file."
WScript.Quit
End If
End Function
Private Function GetFileContent(filePath)
Dim objFS, objFile, objTS
Set objFS = CreateObject("Scripting.FileSystemObject")
Set objFile = objFS.GetFile(filePath)
Set objTS = objFile.OpenAsTextStream(1, 0)
GetFileContent = objTS.Read(objFile.Size)
Set objTS = Nothing
End Function
For Each FileRefIn fso.GetFolder("S:\SOCAL\Section_14\Veg DXFs\").Files
NewFile = WorkingFile
NewFile = Replace(NewFile, OldState, NewState)
NewFile = Replace(NewFile, OldSection, NewSection)
NewFile = Replace(NewFile, OldArea, NewArea)
WriteFile NewFile, WritePath & OutFile & ".gms"
WScript.Echo NewArea
Next
Private Sub WriteFile(strLine,fileName)
On Error Resume Next
Dim objFSO, objFile
Set objFSO = CreateObject("Scripting.FileSystemObject")
Do Until IsObject(objFile)
Set objFile = objFSO.OpenTextFile(fileName, 8, True)
Loop
objFile.WriteLine strLine
objFile.Close
End Sub
Well, that’s actually two questions.
To enumerate files in a directory, you can use FileSystemObject, like this (untested)
const strFolderPath = "C:\Temp\Whatever"
set objFSO = CreateObject( "Scripting.FileSystemObject" )
set objFolder = objFSO.GetFolder( strFolderPath )
set colFiles = objFolder.Files
for each objFile in colFiles
' Do whatever you want with objFile
next
Here's the reference of those objects properties/methods.
And to extract portion of file names, you could use a regular expression.
Here’s some guide how to use'em in VBScript.
The following expression should work for you, it will capture the portion of that file names you asked for:
"^[^_]+_(.*)\.dxf$"
If you need to edit the content of the .dxf files, you will need to work within the AutoCAD VBA (Visual Basic for Applications) environment.
If that is the case, you will need to start with something like below:
GetObject("AutoCAD.Application.20")
CreateObject("AutoCAD.Application.20")
https://knowledge.autodesk.com/search-result/caas/CloudHelp/cloudhelp/2015/ENU/AutoCAD-ActiveX/files/GUID-0225808C-8C91-407B-990C-15AB966FFFA8-htm.html
** Please take note that "VBA is no longer distributed with the AutoCAD installation; it must be downloaded and installed separately. The VBA Enabler for Autodesk AutoCAD can be downloaded here."
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)
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
'**********************************************************************************************
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.
I have a VBS list script to list file,with various dates. All of the files are MS Word documents but I want the AUTHOR from the document attributes (I tried googling "author" attribute not the best search).
I am after a text list of all the documents in a folder :- File name , date accessed, date created, date modified and AUTHOR. I was hoping VBS would crack it but if there is another solution out there I am open to suggestions.
On Error Resume Next
Const WINDOW_HANDLE = 0
Const BIF_EDITBOX = &H10
Const BIF_NONEWFOLDER = &H0200
Const BIF_RETURNONLYFSDIRS = &H1
Set objShell = CreateObject("Shell.Application")
Set wshShell = CreateObject("WScript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")
'**Browse For Folder To Be Processed
strPrompt = "Please select the folder to process."
intOptions = BIF_RETURNONLYFSDIRS + BIF_NONEWFOLDER + BIF_EDITBOX
strTargetPath = wshShell.SpecialFolders("MyDocuments")
strFolderPath = Browse4Folder(strPrompt, intOptions, strTargetPath)
Set objNewFile = objFSO.CreateTextFile(strFolderPath & "\filelist.txt", True)
Set objFolder = objFSO.GetFolder(strFolderPath)
Set objColFiles = objFolder.Files
For Each file In objColFiles
objNewFile.WriteLine(file.Name)
objNewFile.WriteLine(file.DateCreated)
objNewFile.WriteLine(file.DateLastAccessed)
objNewFile.WriteLine(file.DateLastModified)
Next
objNewFile.Close
'**Browse4Folder Function
Function Browse4Folder(strPrompt, intOptions, strRoot)
Dim objFolder, objFolderItem
On Error Resume Next
Set objFolder = objShell.BrowseForFolder(0, strPrompt, intOptions, strRoot)
If (objFolder Is Nothing) Then
Wscript.Quit
End If
Set objFolderItem = objFolder.Self
Browse4Folder = objFolderItem.Path
Set objFolderItem = Nothing
Set objFolder = Nothing
End Function
You'll have to go through the properties of the Word Application object.
Look here for instance how to do that.
Should be something like this:
Set oWord = CreateObject("Word.Application")
Set oDoc = oWord.Documents.Open("myWordDocument.doc")
Set sAuthor = oDoc.BuiltInDocumentProperties("Author")