I have a file selection window. It's fine. Becouse I can't show all files, so I used filter. I want to view only txt and xml files and filter is OK., but I need to view both types of files simultaneously. Now when window is opening only txt files are show and to show xml files I have to change filter every time. How can I make filter with "OR"? Somebody can help me?
My code:
On Error Resume Next
'--- choose file ---------------
Function GetFileDlgEx(sIniDir,sFilter,sTitle)
Set oDlg = CreateObject("WScript.Shell").Exec("mshta.exe ""about:<object id=d classid=clsid:3050f4e1-98b5-11cf-bb82-00aa00bdce0b></object><script>moveTo(0,-9999);eval(new ActiveXObject('Scripting.FileSystemObject').GetStandardStream(0).Read("&Len(sIniDir)+Len(sFilter)+Len(sTitle)+41&"));function window.onload(){var p=/[^\0]*/;new ActiveXObject('Scripting.FileSystemObject').GetStandardStream(1).Write(p.exec(d.object.openfiledlg(iniDir,null,filter,title)));close();}</script><hta:application showintaskbar=no />""")
oDlg.StdIn.Write "var iniDir='" & sIniDir & "';var filter='" & sFilter & "';var title='" & sTitle & "';"
GetFileDlgEx = oDlg.StdOut.ReadAll
End Function
Set fso = CreateObject("Scripting.FileSystemObject")
CurrentDirectory = fso.GetAbsolutePathName(".")
sFilter = "Text files (*.txt)|*.txt|XML files(*.xml)|*.xml||"
sTitle = "You can select your file"
MyFile = GetFileDlgEx(Replace(sIniDir,"\","\\"),sFilter,sTitle)
Set objFile = FSO.GetFile(MyFile)
sName = objFile.Name
sPath = objFile.Path
sPath = Left(sPath, Len(sPath)-Len(sName))
f.Close
fso.Close
If MyFile = "" Then
msgbox "File not selected"
WScript.Quit
End if
vchoose = sPath & sName
msgbox vchoose
Related
How to replace a specific string with the filename? Example: I have several files with different names (like: Test.asp, Constant.asp, Letter.asp, etc.) within a subfolder that contain the text "ABC123". I would like to replace the "ABC123" in each file with the filename.
Below is the code I have that finds string and replaces it with a specific string but it doesn't do the job that I listed above.
Option Explicit
Dim objFilesystem, objFolder, objFiles, objFile, tFile, objShell, objLogFile,objFSO, objStartFolder, colFiles
Dim SubFolder, FileText, bolWriteLog, strLogName, strLogPath, strCount, strCount2, strOldText, strNewText, strEXT
bolWriteLog = True
Const ForReading = 1
Const ForWriting = 2
Const TriStateUseDefault = -2
Set objFilesystem = WScript.CreateObject("Scripting.FileSystemObject")
Set objShell = CreateObject("WScript.Shell")
strLogName = "log.txt"
strLogPath = "C:\" & strLogName
strCount = 0
strCount2 = 0
strOldText = "ABC123"
strNewText = ""
strEXT = "asp"
'Initialize log file
If bolWriteLog Then
On Error Resume Next
Set objLogFile = objFileSystem.OpenTextFile(strLogPath, 2, True)
WriteLog "############### Start Log ##################"
If Not Err.Number = 0 Then
MsgBox "There was a problem opening the log file for writing." & Chr(10) & _
"Please check whether """ & strLogPath & """ is a valid file and can be openend for writing." & _
Chr(10) & Chr(10) & "If you're not sure what to do, please contact your support person.", vbCritical, "Script Error"
WScript.Quit
End If
On Error Goto 0
End If
Set objFSO = CreateObject("Scripting.FileSystemObject")
objStartFolder = "D:\MyFolder"
Set objFolder = objFSO.GetFolder(objStartFolder)
WScript.Echo objFolder.Path
Set colFiles = objFolder.Files
For Each objFile In colFiles
'WScript.Echo objFile.Name
' Now we have an exception for all files that can not be opened in text modus: all extensions such as "exe" should be listed upfront.
ReplaceText(objFile)
Next
ShowSubfolders objFSO.GetFolder(objStartFolder)
Sub ReplaceText(objFile)
If InStr(1, strEXT, Right(LCase(objFile.Name), 3)) = 0 Or objFile.Size = 0 Then
Else
strCount = strCount + 1
WriteLog("Opening " & objFile.Name)
Set tFile = objFile.OpenAsTextStream(ForReading, TriStateUseDefault)
FileText = tFile.ReadAll
tFile.Close
If InStr(FileText, strOldText) Then
WriteLog("Replacing " & strOldText & " with " & strNewText & ".")
FileText = Replace(FileText, strOldText, strNewText)
WriteLog("Text replaced")
Else
WriteLog(strOldText & " was not found in the file.")
strCount2 = strCount2 + 1
End If
Set tFile = objFile.OpenAsTextStream(ForWriting, TriStateUseDefault)
tFile.Write FileText
tFile.Close
FileText = ""
strCount = 0
strCount2 = 0
End If
End Sub
Sub ShowSubFolders(Folder)
For Each Subfolder in Folder.SubFolders
'WScript.Echo Subfolder.Path
Set objFolder = objFSO.GetFolder(Subfolder.Path)
Set colFiles = objFolder.Files
For Each objFile in colFiles
'WScript.Echo objFile.Name
ReplaceText(objFile)
Next
ShowSubFolders Subfolder
Next
End Sub
WriteLog "############### EndLog ##################"
WScript.Echo "Script Complete"
objShell.Run "C:\" & strLogName
'Clear environment and exit
On Error Resume Next
Set tFile = Nothing
Set objFile = Nothing
Set objFiles = Nothing
Set objFolder = Nothing
Set objLogFile = Nothing
Set objFilesystem = Nothing
Set objShell = Nothing
WScript.Quit
'Subs and functions ********** DO NOT EDIT ***************
Sub WriteLog(sEntry)
If bolWriteLog Then objLogFile.WriteLine(Now() & ": Log: " & sEntry)
End Sub
I can give you a one line Ruby solution, should be not too difficult to translate that in Python but somewhat more extensive in VbScript I am afraid. First a generic search and replace version.
ARGV[0..-3].each{|f| File.write(f, File.read(f).gsub(ARGV[-2],ARGV[-1]))}
Save it in a script, eg replace.rb
You start in on the command line (here cmd.exe) with
replace.rb *.txt <string_to_replace> <replacement>
broken down so that I can explain what's happening but still executable
# ARGV is an array of the arguments passed to the script.
ARGV[0..-3].each do |f| # enumerate the arguments of this script from the first to the last (-1) minus 2
File.write(f, # open the argument (= filename) for writing
File.read(f) # open the argument (= filename) for reading
.gsub(ARGV[-2],ARGV[-1])) # and replace all occurances of the beforelast with the last argument (string)
end
And finally your request to replace ABC123 with the filename.
Of course tested and working
ARGV[0..-1].each{|f| File.write(f, File.read(f).gsub('ABC123', f))}
Contents of one of my testfiles (1.txt) after executing
test phrase
1.txt
EDIT
I see you want subfolder recursion on a fixed folder, no problem
Dir['**/*'].each{|f| File.write(f, File.read(f).gsub('ABC123', f)) unless File.directory?(f) }
I need some help with this VB script (edit: it is being used in QlikView)- it is copying a file to a different location (checks if the file already exists in the destination folder).
It works when the source filename and location is hardcoded but this is going to be a variable which is defined in a different macro.
So the source filename and location will be defined by varFileOpen.
Basically in the code, instead of:
SourceFile = "C:\file_path\file_name.txt"
to be like this:
SourceFile = varFileOpen
where varFileOpen has been defined from a different SUB (it is the full file path).... I can't get it to work?
Sub that creates the varFileOpen:
'Sub to get open file dialog
SUB ShowOpen
OpenSave "varFileOpen", 0, "Text file (*.txt)|*.txt|All files (*.*)|*.*", "h:\", "Select a file to open"
END SUB
' Sub to show browse folder dialog
SUB Folder (objVariable)
ON ERROR RESUME NEXT
SET objShell = CREATEOBJECT("Shell.Application")
SET objFolder = objShell.BrowseForFolder (WINDOW_HANDLE, TITLE, OPTIONS, ROOT)
SET objFolderItem = objFolder.Self
strPathAndFile = objFolderItem.Path
SET objSavePath = ActiveDocument.Variables(objVariable)
objSavePath.SetContent strPathAndFile, TRUE
ON ERROR GOTO 0
END SUB
' Sub to show open/save dialog
SUB OpenSave (objVariable, intType, strFilter, strInitialDirectory, strDialogText)
' Create objects
SET objShell = CREATEOBJECT("WScript.Shell")
SET objFSO = CREATEOBJECT("Scripting.FileSystemObject")
strTempDir = objShell.ExpandEnvironmentStrings("%TEMP%")
strTempFile = strTempDir & "\" & objFSO.GetTempName
' Temporary powershell script file to be invoked
strPSFile = tempFile & ".ps1"
' Temporary file to store standard output from command
strPSOutFile = tempFile & ".txt"
' Create script to run
strPSScript = strPSScript & "[System.Reflection.Assembly]::LoadWithPartialName(""System.windows.forms"") | Out-Null" & vbCRLF
' Check type (Open (0) or Save (1))
IF intType = 1 THEN
strPSScript = strPSScript & "$dlg = New-Object System.Windows.Forms.SaveFileDialog" & vbCRLF
ELSE
strPSScript = strPSScript & "$dlg = New-Object System.Windows.Forms.OpenFileDialog" & vbCRLF
END IF
' Set initial directory
strPSScript = strPSScript & "$dlg.initialDirectory = " & CHR(34) & strInitialDirectory & CHR(34) & vbCRLF
' Set file filter/s
strPSScript = strPSScript & "$dlg.filter = " & CHR(34) & strFilter & CHR(34) & vbCRLF
strPSScript = strPSScript & "$dlg.FilterIndex = 1" & vbCRLF
' Set dialog text
strPSScript = strPSScript & "$dlg.Title = " & CHR(34) & strDialogText & CHR(34) & vbCRLF
' Show help (seems it must be set to true)
strPSScript = strPSScript & "$dlg.ShowHelp = $True" & vbCRLF
' Show the dialog
strPSScript = strPSScript & "$dlg.ShowDialog() | Out-Null" & vbCRLF
strPSScript = strPSScript & "Set-Content """ &strPSOutFile & """ $dlg.FileName" & vbCRLF
' Write result
SET objResultFile = objFSO.CreateTextFile(strPSFile, TRUE)
objResultFile.WriteLine(strPSScript)
objResultFile.Close
SET objResultFile = NOTHING
' Run command in PowerShell
strPSCMD = "powershell -ExecutionPolicy unrestricted &'" & strPSFile & "'"
objShell.Run strPSCMD, 0, TRUE
' Open result file and read result
SET objResultFile = objFSO.OpenTextFile(strPSOutFile, 1, 0, -2)
strPathAndFile = objResultFile.ReadLine
objResultFile.Close
SET objResultFile = NOTHING
' Add to result to variable
SET objSavePath = ActiveDocument.Variables(objVariable)
objSavePath.SetContent strPathAndFile, TRUE
' Delete temp-files
objFSO.DeleteFile(strPSFile)
objFSO.DeleteFile(strPSOutFile)
END SUB
The above code opens explorer & you are able to select a file and the path is copied - varFileOpen.
The following SUB moves the file:
SUB movefile
Const DestinationFile = "c:\destfolder\anyfile.txt"
Const SourceFile = "C:\file_path\file_name.txt"
Set fso = CreateObject("Scripting.FileSystemObject")
'Check to see if the file already exists in the destination folder
If fso.FileExists(DestinationFile) Then
'Check to see if the file is read-only
If Not fso.GetFile(DestinationFile).Attributes And 1 Then
'The file exists and is not read-only. Safe to replace the file.
fso.CopyFile SourceFile, "C:\destfolder\", True
Else
'The file exists and is read-only.
'Remove the read-only attribute
fso.GetFile(DestinationFile).Attributes = fso.GetFile(DestinationFile).Attributes - 1
'Replace the file
fso.CopyFile SourceFile, "C:\destfolder\", True
'Reapply the read-only attribute
fso.GetFile(DestinationFile).Attributes = fso.GetFile(DestinationFile).Attributes + 1
End If
Else
'The file does not exist in the destination folder. Safe to copy file to this folder.
fso.CopyFile SourceFile, "C:\destfolder\", True
End If
Set fso = Nothing
END SUB
You will need to pass the value into the Sub for it to have scope, which means you will need to define the sub like this so that it accepts a parameter
Public Sub MySub(byVal SourceFile)
ByVal just means you pass the Value of the variable rather than the actual variable itself.
And you would call it from the other sub with
MySub varFileOpen
EDIT: Based on the code displayed above, you would need to change Sub movefile to Sub movefile(byVal SourceFile) and remove the Const delaration of SourceFile. Once that was done, all you would have to do is change whatever is calling movefile (I can't see anything in the code you've posted doing this?) to call it with movefile varToOpen instead
Try my CustomFileDialog.
Usage:
Dim fDialog
Set fDialog = New CustomFileDialog
fDialog.FilterString = "Text Files (*.txt)|*.txt"
fDialog.InitialDirectory = "C:\"
fDialog.DialogText = "Select a file to open"
fDialog.Show
fDialog.MoveFile "C:\stackoverflow\temp\New File Name.TXT"
CustomFileDialog
Class CustomFileDialog
Public SourceFile
Public FilterString
Public InitialDirectory
Public DialogText
Public Sub Show
Set toolkit = CreateObject("Vbsedit.toolkit")
Files = toolkit.OpenFileDialog(InitialDirectory, FilterString, False, DialogText)
If UBound(Files) >= 0 Then
SourceFile = Files(0)
Else
SourceFile = ""
End If
End Sub
Public Sub MoveFile(DestinationFile)
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FileExists(DestinationFile) Then fso.DeleteFile DestinationFile, True
fso.CopyFile SourceFile, DestinationFile, True
End Sub
End Class
I have made the script FindAndReplace.vbs which simply watches a folder and finds any desired string in the filenames and replaces that string with a desired string.
Now, What I´m trying to create is a VBScript (ConfigureFindAndReplace.vbs) that will easily configure the following 3 things in the FindAndReplace.vbs code:
Browse and select which folder to watch (targetPath)
Which text string to search for in the filenames of the files inside this folder (strFind)
Which string to replace with (strReplace)
I want the script to be user friendly for users with no programming skills.
And I want the main executable script FindAndReplace.vbs to automatically be updated EVERY time the ConfigureFindAndReplace.vbs is run.
To better help you understand here is th
e link to a .zip file containing both of the above mentioned files. This is as far as I can get and I´ve been stuck for 2 days now:
https://www.dropbox.com/s/to3r3epf4ffyedb/StackOverFlow.zip?dl=0
Hope I explained it properly. If not, let me know whatever you need to know.
Thanks in advance:)
And here are the codes from the files:
ConfigureFindAndReplace.vbs:
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objShell = CreateObject ("Shell.Application")
Set objTFolder = objShell.BrowseForFolder (0, "Select Target Folder", (0))
targetPath = objTFolder.Items.Item.Path
Dim oFSO
Set oFSO = CreateObject("Scripting.FileSystemObject")
sScriptDir = oFSO.GetParentFolderName(WScript.ScriptFullName) & "/"
strFind = InputBox("Add string to find.","String to Find", "")
If strFind = "" Then
Wscript.Quit
End If
strReplace = InputBox("Add string to replace with.","Replace with", "")
Dim VarFind
Dim VarReplace
Dim VarPath
VarFind = strFind
VarReplace = strReplace
VarPath = targetPath
Dim WshShell
Set WshShell = CreateObject("WScript.Shell")
WshShell.Run sScriptDir & "FindAndReplace.vbs /strfolderpath:" & VarPath
WshShell.Run sScriptDir & "FindAndReplace.vbs /strfind:" & VarPath
WshShell.Run sScriptDir & "FindAndReplace.vbs /strreplace:" & VarPath
FindAndReplace.vbs:
'Written by Terje Borchgrevink Nuis on 15.12.2014
Set objFSO = CreateObject("Scripting.FileSystemObject")
Dim strFind
Dim strReplace
Dim strFolderPath
strFolderPath = WScript.Arguments.Named("strfolderpath")
targetPath = strFolderPath
'Max number of times to replace string
strCount = 999
'Comparison type: 0 = case sensitive, 1 = case insensitive
strCompare = 1
If targetPath = "" Then
Wscript.Quit
End If
strFind = WScript.Arguments.Named("strfind")
If strFind = "" Then
Wscript.Quit
End If
strReplace = WScript.Arguments.Named("strreplace")
Set objFolder = objFSO.GetFolder(targetPath)
fileRename objFolder
Sub fileRename(folder)
Do
Wscript.sleep 10000
'Loop through the files in the folder
For Each objFile In folder.Files
filename = objFile.Name
ext = objFSO.getExtensionName(objFile)
safename = Left(filename, Len(filename) - Len(ext) - 1)
strStart = 1
safename = Replace(safename, strFind,strReplace,strStart,strCount,strCompare)
safename = trim(safename)
On Error Resume Next
'Terminate if filename stop.txt is found
If filename="STOP.txt" Then
result = MsgBox ("Are you sure you want to terminate the following VBScript?" & vbNewLine & vbNewLine & "FindAndReplace.vbs", vbOKCancel+vbSystemModal , "Terminate VBScript")
Select Case result
Case vbOK
WScript.quit
Case vbCancel
MsgBox "FindAndReplace.vbs is still running in the background.",,"Information"
End Select
End If
'Only rename if new name is different to original name
If filename <> safename & "." & ext Then
objFSO.MoveFile objFile.Path, objFile.ParentFolder.Path & "\" & safename & "." & ext
End If
If Err.Number <> 0 Then
WScript.Echo "Error renaming: " & filename.path & "Error: " & Err.Description
Err.Clear
End If
Next
Loop
End Sub
You think you want ConfigureFindAndReplace to change the other script, this is a bad idea.
You don't know it yet, but what you actually want is for FindAndReplace to read those items from a configuration file.
If the config file is well formed and easy to read, then your users can directly update the config file, so you may not even need the ConfigureFindAndReplace script.
How?
Have a text file with 3 lines
Target Folder=c:\DataFolder
String to find=a string
Replace with=Replace a string with this string
Then in FindAndReplace, before doing any work, you open this file and read in the three lines.
Split the lines on the '=' sign. The left half is the setting and the right half is the value.
Math these up to three variables in the script
If configLineLeft = "Target Folder" then REM Each of these should be case insensitive match
REM e.g. lcase(configLineLeft) = lcase("Target Folder")
TargetFolder = configLineRight
else if configLineLeft = "String to find" then
FindString = configLineRight
else if configLineLeft = "Replace with" then
ReplaceString = configLineRight
else
REM REPORT A PROBLEM TO THE USER AND EXIT
EXIT SUB
end if
You'd do the above in a while loop (while not end of file), reading each line and testing to see which setting it is.
As I can't find any VBScript in your .Zip, some general advice. If you want a not-to-be-edited script to do different things
let the script access parameters/arguments and specifying the differences by calling the script with different arguments: cscript FindAndReplace.vbs "c:\some\folder" "param" "arg"
let the script access config data (from a .txt, .ini, .xml, .json, ... file; from a database; from the registry; ...) and use the config script to set these data
use a template/placeholder file to generate (different version of) the script
I would start with the first approach.
After reading your edit:
Instead of calling your script trice with bad args:
WshShell.Run sScriptDir & "FindAndReplace.vbs /strfolderpath:" & VarPath
WshShell.Run sScriptDir & "FindAndReplace.vbs /strfind:" & VarPath
WshShell.Run sScriptDir & "FindAndReplace.vbs /strreplace:" & VarPath
execute it once with proper args:
WshShell.Run sScriptDir & "FindAndReplace.vbs /strfolderpath:" & VarPath & " /strfind:" & VarFind & "/strreplace:" & VarReplace
(untested; you need to check the names and take care of proper quoting; cf here)
I am working on a project that requires me to search and list all files in a folder that could have multiple sub folders and write it to text documents.
Primarily the file extension i will be searching for is a .Doc, but I will need to list the other files found in said directory as well.
To make things slightly more difficult I want the text documents to be sorted by File type and another by Directory.
I do not know how possible this is, but I have search for methods online, but have as of yet found correct syntax.
Any help will be greatly appreciated.
I write this in the past, should server as a base for your version. I know it's not .NET, still I hope it helps something. It prompts the user for a path to scan, recurses into folders, and writes the file name, path, and owner into a CSV file. Probably really inefficient and slow, but does the job.
Main() ' trickster yo
Dim rootFolder 'As String
Dim FSO 'As Object
Dim ObjOutFile
Dim objWMIService 'As Object
Sub Main()
StartTime = Timer()
If Wscript.Arguments.Count = 1 Then ' if path provided with the argument, use it.
rootFolder = Wscript.Arguments.Item(0)
Else
rootFolder = InputBox("Give me the search path : ") ' if not, ask for it
End If
Set FSO = CreateObject("Scripting.FileSystemObject")
Set ObjOutFile = FSO.CreateTextFile("OutputFiles.csv")
Set objWMIService = GetObject("winmgmts:")
ObjOutFile.WriteLine ("Path, Owner") ' set headers
Gather (rootFolder)
ObjOutFile.Close ' close the stream
EndTime = Timer()
MsgBox ("Done. (ran for " & FormatNumber(EndTime - StartTime, 2) & "s.)")
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function Gather(FolderName)
On Error Resume Next
Dim ObjFolder
Dim ObjSubFolders
Dim ObjSubFolder
Dim ObjFiles
Dim ObjFile
Set ObjFolder = FSO.GetFolder(FolderName)
Set ObjFiles = ObjFolder.Files
For Each ObjFile In ObjFiles 'Write all files to output files
Set objFileSecuritySettings = _
objWMIService.Get("Win32_LogicalFileSecuritySetting='" & ObjFile.Path & "'")
intRetVal = objFileSecuritySettings.GetSecurityDescriptor(objSD)
If intRetVal = 0 Then
owner = objSD.owner.Domain & "\" & objSD.owner.Name
ObjOutFile.WriteLine (ObjFile.Path & ";" & owner) ' write in CSV format
End If
Next
Set ObjSubFolders = ObjFolder.SubFolders 'Getting all subfolders
For Each ObjFolder In ObjSubFolders
Set objFolderSecuritySettings = _
objWMIService.Get("Win32_LogicalFileSecuritySetting='" & ObjFile.Path & "'")
intRetVal = objFolderSecuritySettings.GetSecurityDescriptor(objSD)
If intRetVal = 0 Then
owner = objSD.owner.Domain & "\" & objSD.owner.Name
ObjOutFile.WriteLine (ObjFolder.Path & ";" & owner) ' write in CSV format
End If
Gather (ObjFolder.Path)
Next
End Function
My open/save dialog box that used to work on windows XP no longer works on my Windows 7 64-bit. I have heard that 'MSComDlg.CommonDialog' is not compatible with 64-bit. Here is my old code:
' Sub to show open/save dialog
SUB OpenSave (varOpenSaveInputBox, varOpenSaveType, varOpenSaveFilter)
' Create object
SET objComDlg32 = CreateObject("MSComDlg.CommonDialog")
' Set memory buffer
objComDlg32.MaxFileSize = 260
' Set filter
objComDlg32.Filter = varOpenSaveFilter
' Show dialog
IF varOpenSaveType = 0 Then
objComDlg32.ShowOpen
ELSE
objComDlg32.ShowSave
End IF
' Get filename from dialog
strOpenSave = objComDlg32.FileName
' Check IF dialog is cancelled
IF strOpenSave <> vbNullString Then
' Set to variable
objOpenSave.SetContent strOpenSave, TRUE
End If
END SUB
I would really appreciate if you be more specific with your answer rather than "Use this!". DLL and OCX is not really my strong suit. Thanks.
I'm using this code, which I found somewhere on the internet (possibly even on StackOverflow. I don't remember exactly)
Function ChooseFile (ByVal initialDir, filter)
dim shel, fso, tempdir, tempfile, powershellfile, powershellOutputFile,psScript, textFile
Set shell = CreateObject("WScript.Shell")
Set fso = CreateObject("Scripting.FileSystemObject")
tempDir = shell.ExpandEnvironmentStrings("%TEMP%")
tempFile = tempDir & "\" & fso.GetTempName
' temporary powershell script file to be invoked
powershellFile = tempFile & ".ps1"
' temporary file to store standard output from command
powershellOutputFile = tempFile & ".txt"
'if the filter is empty we use all files
if len(filter) = 0 then
filter = "All Files (*.*)|*.*"
end if
'input script
psScript = psScript & "[System.Reflection.Assembly]::LoadWithPartialName(""System.windows.forms"") | Out-Null" & vbCRLF
psScript = psScript & "$dlg = New-Object System.Windows.Forms.OpenFileDialog" & vbCRLF
psScript = psScript & "$dlg.initialDirectory = """ &initialDir & """" & vbCRLF
'psScript = psScript & "$dlg.filter = ""ZIP files|*.zip|Text Documents|*.txt|Shell Scripts|*.*sh|All Files|*.*""" & vbCRLF
psScript = psScript & "$dlg.filter = """ & filter & """" & vbCRLF
' filter index 4 would show all files by default
' filter index 1 would should zip files by default
psScript = psScript & "$dlg.FilterIndex = 1" & vbCRLF
psScript = psScript & "$dlg.Title = ""Select a file""" & vbCRLF
psScript = psScript & "$dlg.ShowHelp = $True" & vbCRLF
psScript = psScript & "$dlg.ShowDialog() | Out-Null" & vbCRLF
psScript = psScript & "Set-Content """ &powershellOutputFile & """ $dlg.FileName" & vbCRLF
'MsgBox psScript
Set textFile = fso.CreateTextFile(powershellFile, True)
textFile.WriteLine(psScript)
textFile.Close
Set textFile = Nothing
' objShell.Run (strCommand, [intWindowStyle], [bWaitOnReturn])
' 0 Hide the window and activate another window.
' bWaitOnReturn set to TRUE - indicating script should wait for the program
' to finish executing before continuing to the next statement
Dim appCmd
appCmd = "powershell -ExecutionPolicy unrestricted &'" & powershellFile & "'"
'MsgBox appCmd
shell.Run appCmd, 0, TRUE
' open file for reading, do not create if missing, using system default format
Set textFile = fso.OpenTextFile(powershellOutputFile, 1, 0, -2)
ChooseFile = textFile.ReadLine
textFile.Close
Set textFile = Nothing
fso.DeleteFile(powershellFile)
fso.DeleteFile(powershellOutputFile)
End Function
This is VBA but it may be enough to point you in the right direction. The 3 declares the type of dialog you wish to open. You can find that and more information here: http://msdn.microsoft.com/en-us/library/office/ff865284.aspx.
Sub FileSelect (Multi as Boolean)
' Set Dlg = Application.FileDialog(msoFileDialogFilePicker)
Set Dlg = Access.Application.FileDialog(3)
With Dlg
.Title = "Select the file you want to open"
.AllowMultiSelect = Multi
If .Show = -1 Then
txtFilePath = .InitialFileName
Else
Exit Function
End If
End With
FileSelect = Dlg.SelectedItems(1)
End Function