I found a VB Script example for opening a file browser, which I used in a custom action in WiX. However, the VB Script function I use is called BrowseForFolder() (not browseforfile) and only seems to return a value when a directory is selected, but not when an individual file is selected. Here is the custom action:
<CustomAction Id="File" Script="vbscript" Execute="immediate" Return="ignore">
<![CDATA[
Dim shell
Set shell = CreateObject("Shell.Application")
Dim file
Set file = shell.BrowseForFolder(0, "Choose a file:", &H4000)
Session.Property("FileName") = file.self.Path
]]>
</CustomAction>
Using this method, I can actually see individual files in the dialog, which is a step up from Wix's built-in directory browser.
Now I just need to be able to retrieve individual file names, not just names of folders.
I've found this code.
https://gist.github.com/wangye/1932941
and made some changes on it to a better understanding
WScript.Echo GetOpenFileName("C:\", "")
'
' Description: VBScript/VBS open file dialog
' Compatible with most Windows platforms
' Author: wangye <pcn88 at hotmail dot com>
' Website: http://wangye.org
'
' dir is the initial directory; if no directory is
' specified "Desktop" is used.
' filter is the file type filter; format "File type description|*.ext"
'
'
Public Function GetOpenFileName(dir, filter)
Const msoFileDialogFilePicker = 3
If VarType(dir) <> vbString Or dir="" Then
dir = CreateObject( "WScript.Shell" ).SpecialFolders( "Desktop" )
End If
If VarType(filter) <> vbString Or filter="" Then
filter = "All files|*.*"
End If
' try to choose the way to open the dialog box. Array: TryObjectNames
Dim i,j, objDialog, TryObjectNames
TryObjectNames = Array( _
"UserAccounts.CommonDialog", _
"MSComDlg.CommonDialog", _
"MSComDlg.CommonDialog.1", _
"Word.Application", _
"SAFRCFileDlg.FileOpen", _
"InternetExplorer.Application" _
)
On Error Resume Next
Err.Clear
For i=0 To UBound(TryObjectNames)
Set objDialog = WSH.CreateObject(TryObjectNames(i))
If Err.Number <> 0 Then
Err.Clear
Else
Exit For
End If
Next
' Select the way to dealing the object dialog
Select Case i
Case 0,1,2
' 0. UserAccounts.CommonDialog XP Only.
' 1.2. MSComDlg.CommonDialog MSCOMDLG32.OCX must registered.
If i=0 Then
objDialog.InitialDir = dir
Else
objDialog.InitDir = dir
End If
objDialog.Filter = filter
If objDialog.ShowOpen Then
GetOpenFileName = objDialog.FileName
End If
Case 3
' 3. Word.Application Microsoft Office must installed.
objDialog.Visible = False
Dim objOpenDialog, filtersInArray
filtersInArray = Split(filter, "|")
Set objOpenDialog = _
objDialog.Application.FileDialog( _
msoFileDialogFilePicker)
With objOpenDialog
.Title = "Open File(s):"
.AllowMultiSelect = False
.InitialFileName = dir
.Filters.Clear
For j=0 To UBound(filtersInArray) Step 2
.Filters.Add filtersInArray(j), _
filtersInArray(j+1), 1
Next
If .Show And .SelectedItems.Count>0 Then
GetOpenFileName = .SelectedItems(1)
End If
End With
objDialog.Visible = True
objDialog.Quit
Set objOpenDialog = Nothing
Case 4
' 4. SAFRCFileDlg.FileOpen xp 2003 only
' See http://www.robvanderwoude.com/vbstech_ui_fileopen.php
If objDialog.OpenFileOpenDlg Then
GetOpenFileName = objDialog.FileName
End If
Case 5
Dim IEVersion,IEMajorVersion, hasCompleted
hasCompleted = False
Dim shell
Set shell = CreateObject("WScript.Shell")
' ????IE??
IEVersion = shell.RegRead( _
"HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Internet Explorer\Version")
If InStr(IEVersion,".") > 0 Then
' ??????
IEMajorVersion = CInt(Left(IEVersion, InStr(IEVersion,".")-1))
If IEMajorVersion > 7 Then
' ???????7,?????IE7,???MSHTA??
' Bypasses c:\fakepath\file.txt problem
' http://pastebin.com/txVgnLBV
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
Dim tempFolder : Set tempFolder = fso.GetSpecialFolder(2)
Dim tempName : tempName = fso.GetTempName()
Dim tempFile : Set tempFile = tempFolder.CreateTextFile(tempName & ".hta")
Dim tempBaseName
tempBaseName = tempFolder & "\" & tempName
tempFile.Write _
"<html>" & _
" <head>" & _
" <title>Browse</title>" & _
" </head>" & _
" <body>" & _
" <input type='file' id='f'>" & _
" <script type='text/javascript'>" & _
" var f = document.getElementById('f');" & _
" f.click();" & _
" var fso = new ActiveXObject('Scripting.FileSystemObject');" & _
" var file = fso.OpenTextFile('" & _
Replace(tempBaseName,"\", "\\") & ".txt" & "', 2, true);" & _
" file.Write(f.value);" & _
" file.Close();" & _
" window.close();" & _
" </script>" & _
" </body>" & _
"</html>"
tempFile.Close
Set tempFile = Nothing
Set tempFolder = Nothing
shell.Run tempBaseName & ".hta", 1, True
Set tempFile = fso.OpenTextFile(tempBaseName & ".txt", 1)
GetOpenFileName = tempFile.ReadLine
tempFile.Close
fso.DeleteFile tempBaseName & ".hta"
fso.DeleteFile tempBaseName & ".txt"
Set tempFile = Nothing
Set fso = Nothing
hasCompleted = True ' ??????
End If
End If
If Not hasCompleted Then
' 5. InternetExplorer.Application IE must installed
objDialog.Navigate "about:blank"
Dim objBody, objFileDialog
Set objBody = _
objDialog.document.getElementsByTagName("body")(0)
objBody.innerHTML = "<input type='file' id='fileDialog'>"
while objDialog.Busy Or objDialog.ReadyState <> 4
WScript.sleep 10
Wend
Set objFileDialog = objDialog.document.all.fileDialog
objFileDialog.click
GetOpenFileName = objFileDialog.value
End If
objDialog.Quit
Set objFileDialog = Nothing
Set objBody = Nothing
Set shell = Nothing
Case Else
MsgBox("No file dialog component found", MsgBoxStyle.Exclamation, "Error")
End Select
Set objDialog = Nothing
End Function
Related
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 managed to find this script to use and backup my files, this is a little more complicated then I need it to be.
I do not need to enter a backup path - from and too every time I run it however this is a handy option for other projects but I would like to backup from a set file path and save to a set file path to save time.
The other issue with this script is the Cancel button does not work, this is an issue I have had before and fixed but I cannot remember how to make the Cancel button function.
Option Explicit
Dim objFSO, strSourceFolder, strDestFolder, strExclusion, strPrompt
Set objFSO = CreateObject("Scripting.FileSystemObject")
strSourceFolder = InputBox("Enter the Source directory path you wish to backup")
strDestFolder = InputBox("Enter the Destination directory path you wish to backup your Data to... (C:/Backup, //Backup-Server/Remotebackup")
Wscript.Echo "Click (OK) to start the Backup!"
CopyFolderStructure strSourceFolder, strDestFolder, strExclusion
Function CopyFolderStructure(strSource, strDestination, strExcludedExt)
Const OVER_WRITE_FILES = True
Dim objDir, objFolder, objFiles, strCurExt, intX, arrExt, blnExclude
Set objDir = objFSO.GetFolder(strSource)
If Not objFSO.FolderExists(strDestination & "\" & objDir.Name) Then
objFSO.CreateFolder(strDestination & "\" & objDir.Name)
End If
If Not IsNoData(strExcludedExt) Then
arrExt = Split(strExcludedExt, ",")
blnExclude = False
End If
For Each objFiles In objFSO.GetFolder(strSource).Files
If Not IsNoData(strExcludedExt) Then
strCurExt = objFSO.GetExtensionName(objFiles.Name)
For intX = 0 To UBound(arrExt)
If LCase(strCurExt) = arrExt(intX) Then
blnExclude = True
Exit For
Else
blnExclude = False
End If
Next
If Not blnExclude Then
objFSO.CopyFile strSource & "\" & objFiles.Name, strDestination & "\" & objDir.Name & "\" & objFiles.Name, OVER_WRITE_FILES
End If
Else
objFSO.CopyFile strSource & "\" & objFiles.Name, strDestination & "\" & objDir.Name & "\" & objFiles.Name, OVER_WRITE_FILES
End If
Next
For Each objFolder In objFSO.GetFolder(strSource).SubFolders
CopyFolderStructure objFolder.Path, strDestination & "\" & objDir.Name, strExcludedExt
Next
End Function
Function BrowseForFolderDialogBox(strTitle)
Const WINDOW_HANDLE = 0
Const NO_OPTIONS = &H0001
Dim objShellApp
Dim objFolder
Dim objFldrItem
Dim objPath
Set objShellApp = CreateObject("Shell.Application")
Set objFolder = objShellApp.BrowseForFolder(WINDOW_HANDLE, strTitle , NO_OPTIONS)
If IsNoData(objFolder) Then
WScript.Echo "You choose to cancel. This will stop this script."
Wscript.Quit
Else
Set objFldrItem = objFolder.Self
objPath = objFldrItem.Path
BrowseForFolderDialogBox = objPath
Set objShellApp = Nothing
Set objFolder = Nothing
Set objFldrItem = Nothing
End If
End Function
Function IsNoData(varVal2Check)
On Error Resume Next
If IsNull(varVal2Check) Or IsEmpty(varVal2Check) Then
IsNoData = True
Else
If IsDate(varVal2Check) Then
IsNoData = False
Elseif varVal2Check = "" Then
IsNoData = True
ElseIf Not IsObject(varVal2Check) Then
IsNoData = False
Else
IsNoData = False
End If
End If
End Function
Wscript.Echo "Backup Has Completed Successfully"
Next code snippet could help (see Arguments Property (WScript Object), InputBox Function and MsgBox Function reference). Note that the Echo method behaves differently depending on which WSH engine you are using.
Option Explicit
Dim objFSO, strSourceFolder, strDestFolder, strExclusion, strPrompt
Dim iBut, sRes, sMes, objArgs
sRes = Wscript.ScriptName
sMes = vbCRLF & "(click (Cancel) button to discard)"
Set objArgs = WScript.Arguments
If objArgs.Count > 1 Then
strSourceFolder = objArgs( 0)
strDestFolder = objArgs( 1)
Else
strSourceFolder = "C:/DataToBackup"
strDestFolder = "D:/Backup"
strSourceFolder = InputBox( "Path you wish to backup" & sMes _
, "Source directory", strSourceFolder)
sRes = sRes & vbNewLine & "strSourceFolder """ & strSourceFolder & """"
If strSourceFolder = "" Then
strDestFolder = ""
Else
strDestFolder = InputBox( "Path you wish to backup your Data to" & sMes _
, "Destination directory", strDestFolder)
sRes = sRes & vbNewLine & "strDestFolder """ & strDestFolder & """"
End If
End If
If strDestFolder = "" Then
sRes = sRes & vbNewLine & "Backup Cancelled!"
Wscript.Echo sRes
Wscript.Quit
Else
iBut=MsgBox(sRes & sMes, vbOKCancel + vbQuestion _
, "Click (OK) to start the Backup!")
If iBut <> vbOK Then Wscript.Quit
End If
'''' for debugging only:
Wscript.Quit '''' for debugging only:
'''' for debugging only:
Set objFSO = CreateObject("Scripting.FileSystemObject")
CopyFolderStructure strSourceFolder, strDestFolder, strExclusion
'''''' and so on...
I'm trying to create a vbscript that moves files from one directory to another, that increments the filename if the file allready exists. I.e. if file.ext exists, new filename is file_01.ext. If file_01.ext exists, new filename is file_02.ext, and so on. I can't get it to work. Any help would be very much appreciated.
Const cVBS = "Vaskedama.vbs" '= script name
Const cLOG = "Vaskedama.log" '= log filename
Const cFOL = "C:\fra\" '= source folder
Const cMOV = "C:\til\" '= dest. folder
Const cDAZ = -1 '= # days
Dim strMSG
strMSG = " files moved from " & cFOL & " to " & cMOV
MsgBox Move_Files(cFOL) & strMSG,vbInformation,cVBS
Function Move_Files(folder)
Move_Files = 0
Dim strDAT
Dim intDAZ
Dim arrFIL()
ReDim arrFIL(0)
Dim intFIL
intFIL = 0
Dim strFIL
Dim intLEN
intLEN = 0
Dim strLOG
strLOG = "echo " & cVBS & " -- " & Now & vbCrLf
Dim dtmNOW
dtmNOW = Now
Dim objFSO
Set objFSO = CreateObject("Scripting.FileSystemObject")
Dim objGFO
Dim objGFI
If Not objFSO.FolderExists(cFOL) _
Or Not objFSO.FolderExists(cMOV) Then
MsgBox "A folder does not exist!",vbExclamation,cVBS
Exit Function
End If
Set objGFO = objFSO.GetFolder(folder)
Set objGFI = objGFO.Files
For Each strFIL In objGFI
strDAT = strFIL.DateCreated
intDAZ = DateDiff("d",strDAT,dtmNOW)
If intDAZ > cDAZ Then
intFIL = intFIL + 1
ReDim Preserve arrFIL(intFIL)
arrFIL(intFIL) = strFIL.Name
If intLEN < Len(strFIL.Name) Then
intLEN = Len(strFIL.Name)
End If
End If
Next
For intFIL = 1 To UBound(arrFIL)
strFIL = arrFIL(intFIL)
Do While (objFSO.FileExists(cMOV & strFIL))
strFil = CreateNewName(strFIL, intFIL)
Loop
objFSO.MoveFile folder & strFIL, cMOV & strFIL
strLOG = strLOG & "move " & folder & strFIL _
& Space(intLEN-Len(strFIL)+1) _
& cMOV & strFIL & vbCrLf
Next
Set objGFI = Nothing
Set objGFO = Nothing
strLOG = strLOG & "echo " & UBound(arrFIL) & " files moved"
objFSO.CreateTextFile(cLOG,True).Write(strLOG)
Set objFSO = Nothing
Move_Files = UBound(arrFIL)
End Function
Function CreateNewName(strValue, intValue)
CreateNewName = strValue & intValue
End Function
As I can't understand your script at all, I'll concentrate on the the task "build a new file name by incrementing a counter". Obviously you have to check for each file whether there is a file with the same name or this name + suffix in the destination folder. The answer to this question for file a is completely independent of all files in the source folder - so I doubt your array makes any sense.
In code:
Const cnMax = 3
Dim goFS : Set goFS = CreateObject("Scripting.FileSystemObject")
Dim oSrcDir : Set oSrcDir = goFS.GetFolder("..\testdata\FancyRename\from")
Dim sDstDir : sDstDir = "..\testdata\FancyRename\to"
Dim oFile, nInc, sNFSpec
For Each oFile In oSrcDir.Files
WScript.Echo "looking at", oFile.Name
nInc = 0
sNFSpec = getNewFSpec(oFile.Name, sDstDir, nInc)
Do While goFS.FileExists(sNFSpec) And nInc <= cnMax
sNFSpec = getNewFSpec(oFile.Name, sDstDir, nInc)
Loop
If nInc > cnMax Then
WScript.Echo "won't copy to", sNFSpec
Else
WScript.Echo "will copy to ", sNFSpec
oFile.Copy sNFSpec
End If
Next
Function getNewFSpec(ByVal sFName, sDstDir, ByRef nInc)
If 0 < nInc Then
Dim sSfx
sSfx = goFS.GetExtensionName(sFName)
If "" <> sSfx Then sSfx = "." & sSfx
sSfx = "_" & Right("00" & nInc, 2) & sSfx
sFName = goFS.GetBaseName(sFName) & sSfx
End If
nInc = nInc + 1
getNewFSpec = goFS.BuildPath(sDstDir, sFName)
End Function
some sample output:
looking at B.txt
will copy to ..\testdata\FancyRename\to\B.txt
looking at C.txt
will copy to ..\testdata\FancyRename\to\C.txt
looking at A.txt
will copy to ..\testdata\FancyRename\to\A.txt
looking at B.txt
will copy to ..\testdata\FancyRename\to\B_01.txt
looking at B.txt
won't copy to ..\testdata\FancyRename\to\B_03.txt
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
I have this VBScript which runs however, while it is processing, it will randomly stop and require a user to hit the spacebar for it to display the rest of its ongoing output.
How do I figure out why this is happening?
Here is a copy of the script:
'On Error Resume Next
Dim arrFolders()
intSize = 0
Function StampNow()
Dim Hr, Mn, Yr, Mon, Dy, Date1
Date1=Now()
Hr=DatePart("h",Date1)
Mn=DatePart("n",Date1)
Yr = DatePart("yyyy",Date1)
Mon = DatePart("m",Date1)
Dy = DatePart("d",Date1)
StampNow = Yr & "-" & Mon & "-" & Dy
end function
'Output log info.
Function OutputToLog (strToAdd)
Dim strDirectory,strFile,strText, objFile,objFolder,objTextFile,objFSO
strDirectory = "c:\log"
strFile = "\dpadmin_copy2run-"& StampNow & ".bat"
'strText = "dpadmin_copy2"
strText = strToAdd
' Create the File System Object.
Set objFSO = CreateObject("Scripting.FileSystemObject")
' Check that the strDirectory folder exists.
If objFSO.FolderExists(strDirectory) Then
Set objFolder = objFSO.GetFolder(strDirectory)
Else
Set objFolder = objFSO.CreateFolder(strDirectory)
'WScript.Echo "Just created " & strDirectory
End If
If objFSO.FileExists(strDirectory & strFile) Then
Set objFolder = objFSO.GetFolder(strDirectory)
Else
Set objFile = objFSO.CreateTextFile(strDirectory & strFile)
'Wscript.Echo "Just created " & strDirectory & strFile
End If
set objFile = nothing
set objFolder = nothing
' OpenTextFile Method needs a Const value
' ForAppending = 8 ForReading = 1, ForWriting = 2
Const ForAppending = 8
Set objTextFile = objFSO.OpenTextFile _
(strDirectory & strFile, ForAppending, True)
' Writes strText every time you run this VBScript.
objTextFile.WriteLine(strText)
objTextFile.Close
End Function
strComputer = "."
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
strFolderName = "D:\1\production\Openjobs"
Set colSubfolders = objWMIService.ExecQuery _
("Associators of {Win32_Directory.Name='" & strFolderName & "'} " _
& "Where AssocClass = Win32_Subdirectory " _
& "ResultRole = PartComponent")
dim diffindates
'Init vars for regex.
Dim retVal, retVal2
Dim Lastprop
Dim objRegExpr 'regex variable
Set objRegExpr = New regexp
Set objRegExprX31 = New regexp
objRegExpr.Pattern = "[0-9][0-9][0-9][0-9][0-9][0-9][A-Z][A-Z][A-Z]"
objRegExprX31.Pattern = "[0-9][0-9][0-9][0-9][0-9][0-9]X31"
objRegExpr.Global = True
objRegExprX31.Global = True
objRegExpr.IgnoreCase = True
objRegExprX31.IgnoreCase = True
'Variables for getting last accessed property.
Dim fs, f
Set fs = CreateObject("Scripting.FileSystemObject")
'Current time vars.
Dim currenttime
currenttime = Now()
ParentFolder = "D:\1\Production\Openjobs\ClosedJobs"
For Each objFolder in colSubfolders
intSize = intSize + 1
retVal = objRegExpr.Test(objFolder.Name)
retVal2 = objRegExprX31.Test(objFolder.Name)
if (retVal OR retVal2 ) then
'set filename to array
strFolderName = objFolder.Name
'Get last modified date.
Set f = fs.GetFolder(objFolder.Name)
Lastprop = f.DateLastModified
'MsgBox(Lastprop)
if ( DateDiff("m", f.DateLastModified, Now()) > 4) then
diffindates = DateDiff("m", f.DateLastModified, Now())
Set objShell = CreateObject("Shell.Application")
Set objCopyFolder = objShell.NameSpace(ParentFolder)
OutputToLog("rem " & f.DateLastModified & ":" & objFolder.Name )
outputtolog("move /Y """ & objFolder.Name & """ " & ParentFolder)
wscript.echo(diffindates & ":" & objFolder.Name & vbCr)
end if
end if
Next
Update
It stops at the line:
Set objTextFile = objFSO.OpenTextFile _
(strDirectory & strFile, ForAppending, True)
with the error Microsoft VBScript runtime error: Permission denied
I'm a little confusd by this. The logfile was only 356kb
I was able to run your script several times without it pausing for input. Run your script with the //X flag to start it in the debugger:
>cscript //nologo //X dpadmin_copy2.vbs"
You should be able to then step through the code.
You can also start putting in wscript.echo trace statements everywhere and see if you can narrow down what it's waiting on.
One thing that's gotten me in the past; If your command console is in QuickEdit mode and you accidentally click anywhere in the console window, the console will hang while it waits for you to press a key.
Well the first step is to remove any global On Error Resume Next statements. Better feedback would come if we could see the script.
You usually get an Permission denied when trying to write to a text file when the text file already has an open handle from some other process or because you have previously opened a handle earlier in you code which you have not closed. I haven't tried this but I don't know why this wouldn't work, you can look at using Handle from Sysinternals (Microsoft) to tell you what process has the open handle for the file. Please see here for a further reference of how to use Handle: http://www.orcsweb.com/blog/post/Closing-open-file-handles.aspx You could also write a second script which runs in a loop to monitor the main script. The second script can verify the first script by doing a WMI Process query which returns only processes that match a defined command line. The second script could then restart the main it stops, alert you, log a file, launch a handle search, etc.