I'm simulating multi-threading with VBA, the code creates multiple vbs files and runs them. But i am not able to delete them after they are completed, it says "can not find script file" Here is my code:
' Write VBScript file to disk
sFileName = ActiveWorkbook.Path & "\Thread_" & agentNr & ".vbs"
intFileNum = FreeFile
Open sFileName For Output As intFileNum
Print #intFileNum, s
Close intFileNum
' Run VBScript file
Set wshShell = CreateObject("Wscript.Shell")
wshShell.Run """" & sFileName & """"
Kill sFileName
Set wshShell = Nothing
Any idea? Thanks
In our original code, as it's in asynchronous mode, Shell has not read the script file before you removing it.
Now I suggest a self-destruction mode.
As comments, we run .vbs again in an asynchronous mode, but the script file will be removed at the end of the vbscript, ie, inside the script itself. The deletion instructions are appended at the end of the VBScript to be created:
Sub sof20351356RunVbScript()
Dim intFileNum As Integer
Dim agentNr As Long
Dim sFileName As String, s As String
Dim wshShell
agentNr = 5
' Write VBScript file to disk
sFileName = ActiveWorkbook.Path & "\Thread_" & agentNr & ".vbs"
'
' In the file, we do our job normally,
' at the end, we kill the vbscript inside the script itself:
'
s = "MyVar = 1" & vbCrLf _
& "'... do foo bar" & vbCrLf
'
' now add the Killing order:
s = s _
& "Set fso = CreateObject(""Scripting.FileSystemObject"")" & vbCrLf _
& "fso.DeleteFile """ & sFileName & """" & vbCrLf
intFileNum = FreeFile
Open sFileName For Output As intFileNum
Print #intFileNum, s
Close intFileNum
' Run VBScript file
Set wshShell = CreateObject("Wscript.Shell")
'
' in synchronous mode:
'wshShell.Run """" & sFileName & """", 0, True
'
' in asynchronous mode:
wshShell.Run """" & sFileName & """", 0, False
'Kill sFileName
Set wshShell = Nothing
End Sub
Ref: http://msdn.microsoft.com/en-us/library/d5fk67ky(v=vs.84).aspx
As I tested so confirmed, before a script begins to run, it's read at 100% in memory by the Shell (Windows Script Interpreter), so the file itself has no more any importance when it starts executing. As a consequence, you can even add the destruction instruction at the beginning of the VBscript, before your true job.
But cmd.exe .bat file cannot be handled as this.
You're trying to delete a script file that is currently running. That's probably what is causing your problem.
How about using the wshShell.Exec method instead of Run? That way you can keep track of whether the VBScript is done running or not, and delay deleting the VBS file until it is done.
Proof-of-concept, not tested:
Dim oExec
Set oExec = wshShell.Exec("sFileName")
'Can launch more processes here...
'Now check if oExec process is done
Do While oExec.Status = 0
'oExec process not done yet...
WScript.Sleep 100
Loop
'It's done. Delete the file.
Kill sFileName
This is of course a simplistic example with only one process. You could launch more of them and store their handles (like oExec) in an array/collection/dictionary. Then periodically check all the handles in succession until they are all done running.
Related
Trying to get VBA to run dir in command prompt using a shell command:
Call Shell("Dir \\rtserver\controlleddocuments\""incoming reports""\" & Left(cmbComponent.Column(1), 3) & "\20" & Left(lstComponentLots.Column(1), 2) & "\*" & lstComponentLots.Column(1) & "* /b /a-d > C:\users\public\tmpcomponentsearch.txt", vbNormalFocus)
DoCmd.TransferText acImportDelim, "pathImport", "z_tmpcomponentsearch",
"C:\users\public\tmpcomponentsearch.txt"
Me.listScannedRecords.Requery
If I debug.print the string in the shell command I get:
Dir \\rtserver\controlleddocuments\"incoming reports"\019\2017\*1702-1015* /b /a-d > C:\users\public\tmpcomponentsearch.txt
which runs fine in command prompt, but I get a 'file not found' error when I try to run it in VBA. I'd rather not create a batch file to do this.
Thanks in advance.
Why use shell at all? Have a play with the FileSystemObject (add a reference to Microsoft Scripting Runtime). Try something along the lines of:
Dim fso As New FileSystemObject
Dim oFolder As Folder
Dim oFile As File
Dim strFolderName As String
strFolderName = "\\rtserver\controlleddocuments\""incoming reports""\019\2017"
Set oFolder = fso.GetFolder(strFolderName)
For Each oFile In oFolder.Files
If oFile.Name Like "*1702-1015*" Then
CurrentDb.Execute "INSERT INTO z_tmpcomponentsearch (col_name) " & _
"VALUES ('" & Replace(oFile.Name, "'", "''") & "')"
End If
Next oFile
Set oFile = Nothing
Set oFolder = Nothing
Set fso = Nothing
I found an answer - sort of. Basically create the batch file with the dir command in it on the fly and then run it:
Public Function search_with_batch_file(searchStr As String)
Const my_filename = "C:\Users\Public\qsd_search.bat"
Dim FileNumber As Integer
Dim wsh As Object
Dim waitOnReturn As Boolean: waitOnReturn = True
Dim windowStyle As Integer: windowStyle = 1
FileNumber = FreeFile
'creat batch file
Open my_filename For Output As #FileNumber
Print #FileNumber, "Dir " & searchStr & " /b /a-d >
C:\users\public\tmpcomponentsearch.txt"
Print #FileNumber, "exit"
Close #FileNumber
'run batch file and wait to complete
Set wsh = VBA.CreateObject("WScript.Shell")
wsh.Run my_filename, windowStyle, waitOnReturn
'Delete batch file
Kill my_filename
End Function
The FSO method was taking about 4-5 seconds to search each time but this method was executing in less than 1 second. It would still be nice to dynamically feed commands right into command prompt without creating a batch file each time, but this works for now.
This question is (almost) already answered here.
To run a DOS command from within VBA using Shell, the command line needs to begin with cmd.exe with the /c parameter, followed by your DOS command, like this:
Shell "cmd.exe /c [your DOS command here]".
For example, to use DOS's ever-efficient DIR command to find a file (the Common Controls Library in this case), putting the (bare) results into a text file:
Shell "cmd.exe /c dir ""C:\Program Files (x86)\mscomctl.ocx"" /b /s > ""C:\MyResults.txt"""
Note that the Shell command returns control immediately to VBA and does not wait for the DOS command to complete, so we need to wait for the file to be created, and the write lock released, before using it.
For example:
Sub ShellTest()
'Uses VBA Shell command to run DOS command, and waits for completion
Dim Command As String
Dim FileName As String
Dim FileHan As Long
Dim ErrNo As Long
'Set output file for results (NB folder must already exist)
FileName = "C:\Temp\Test.txt"
'Remove output file if already exists
If Dir(FileName) > "" Then Kill FileName
'Set command string
Command = "cmd.exe /c dir ""C:\Program Files (x86)\mscomctl.ocx"" /b /s >""" & FileName & """"
'Shell out to DOS to perform the DIR command
Shell Command
'Wait for file creation
Do While Dir(FileName) = ""
Debug.Print "Waiting for file creation...", Time
DoEvents
Loop
'Wait for write lock release
ErrNo = -1
Do While ErrNo <> 0
FileHan = FreeFile 'Find an available file handle
On Error Resume Next 'Disable error trapping while attempting to gain write lock
Open FileName For Append As #FileHan 'Attempt to gain write lock - will fail with error while write lock is held by DOS
ErrNo = Err.Number 'Save error number
On Error GoTo 0 'Re-enable error trapping
Close #FileHan 'Release write lock just obtained (if successful) - fails with no error if lock not obtained
Debug.Print "Waiting for write lock release...", Time
DoEvents
Loop
'Now we can use the results file, eg open it in Notepad
Command = "cmd.exe /c notepad.exe """ & FileName & """"
Shell Command
Debug.Print "Done"
End Sub
The WScript.Shell object has a Run method that runs a DOS command and waits for completion, which leads to simpler code (but you can't do anything in VBA while waiting for completion).
Sub ShellTest2()
'Uses WScript.Shell object to run DOS command and wait for completion
Dim Command As String
Dim FileName As String
Dim FileHan As Long
Dim ErrNo As Long
'Set output file for results (NB folder must already exist)
FileName = "C:\Temp\Test.txt"
'Remove output file if already exists
If Dir(FileName) > "" Then Kill FileName
'Set command string
Command = "cmd.exe /c dir ""C:\Program Files (x86)\mscomctl.ocx"" /b /s >""" & FileName & """"
'Use the WScript shell to perform the DOS command (waits for completion)
CreateObject("WScript.Shell").Run Command, 1, True 'Change 2nd parameter to 0 to hide window
'Now we can use the results file, eg open it in Notepad
Command = "cmd.exe /c notepad.exe """ & FileName & """"
Shell Command
Debug.Print "Done"
End Sub
I am using VBA to create some CSV files which are then used as references so that a batch file can use them as inputs. I have succeeded in making this work but found that I needed the VBA code to wait for the script to complete before continuing. From what I found on the web I should use the Windows Script Host Object Model" which would then allow me to set WaitOnReturn:=True. However I now get "Run-time error '-2147024894 (80070002)': Automation Error The system cannot find the file specified." This is obviously something elementary that I have missed but it is taking me hours to work out what it is. I have searched and not found an answer that seems to help. Here is the code that works, followed by the code that fails. Thanks in advance for any guidance.
Public Sub Create_run_delete_batch_file(Input_File)
Const MY_FILENAME = "E:\Test.bat"
Dim FileNumber As Integer
Dim retVal As Variant
FileNumber = FreeFile
'create batch file
Open MY_FILENAME For Output As #FileNumber
Print #FileNumber, "E:"
Print #FileNumber, "cd " & Chr(34) & "E:\Test_Dir\" & Chr(34)
'Set Current Risk File here
Print #FileNumber, "Script that works goes here" & Input_File
Close #FileNumber
'run batch file
retVal = Shell(MY_FILENAME, vbNormalFocus)
' NOTE THE BATCH FILE WILL RUN, BUT THE CODE WILL CONTINUE TO RUN.
If retVal = 0 Then
MsgBox "An Error Occured"
Close #FileNumber
End
End If
'Delete batch file
Kill MY_FILENAME
End Sub
Public Sub Create_run_delete_batch_file(Input_File)
Const MY_FILENAME = "E:\Test.bat"
Dim FileNumber As Integer
Dim retVal As Variant
Dim wsh As WshShell
Set wsh = New WshShell
FileNumber = FreeFile
'create batch file
Open MY_FILENAME For Output As #FileNumber
Print #FileNumber, "E:"
Print #FileNumber, "cd " & Chr(34) & "E:\Test_Dir\" & Chr(34)
'Set Current Risk File here
Print #FileNumber, "Script that works goes here" & Input_File
Close #FileNumber
'run batch file
'retVal = Shell(MY_FILENAME, vbNormalFocus)
retVal = wsh.Run(MY_FILENAME, WaitOnReturn:=True)
' NOTE THE BATCH FILE WILL RUN, BUT THE CODE WILL CONTINUE TO RUN.
If retVal = 0 Then
MsgBox "An Error Occured"
Close #FileNumber
End
End If
'Delete batch file
Kill MY_FILENAME
End Sub
I am trying to open an Access 2003 .mde file using Excel VBA.
So far I have tried:
Shell ("cscript "C:\User\Folder\Access Database.mde""), vbHide
Now this works perfect to open a .vbs file and the code runs to open the .mde file but does not actually open the database.
I also tried the following:
strdb = "C:\User\Folder\Access Database.mde"
Set AccessApp = CreateObject("Access.Application")
AccessApp.Visible = True
AccessApp.OpenCurrentDatabase.strdb
AccessApp.DoCmd.OpenForm "frmsysteminformation"
Set AccessApp= Nothing
I found this online but it gives me a debug error highlight the line:
Set AccessApp = CreateObject("Access.Application")
Thanks
Edit My company seems to have disabled some of the features as
CreateObject("Outlook.Application")
also doesn't work. Is there a way to run this through cscript?
Just in case anyone stumbles across this same issue I managed to work it out:
Dim sAcc
Dim sFrontEnd
Dim sSec
Dim sUser
Dim objShellDb
Dim sComTxt
'Script Configuration Variable
'*******************************************************************************
'Specify the Fullpath and filename of the msaccess executable
sAcc = "C:\Program Files\Microsoft Office\Office11\MSACCESS.EXE"
'Specify the Fullpath and filename of the database to launch
sFrontEnd = "C:\users\file location\Database to open.mde"
Set objShellDb = CreateObject("WScript.Shell")
'Build the command to launch the database
sComTxt = Chr(34) & sAcc & Chr(34) & " " & Chr(34) & sFrontEnd & Chr(34)
objShellDb.Run sComTxt 'Launch the database
End Sub
I have created a vba script which creates two files. A .vbs file is used to open an external program and send a keystroke. This program is called via a .bat file. The external program (Mathcad) opens, but it won't carry out the later operations (sendkeys). How could I debug the .vbs file unless anyone can spot the error?
Public Sub Execute_Mathcad()
Dim ExportPath As String
Dim iFileNum As Long
Dim iFileNumvbs As Long
Dim wsActive As Worksheet
Dim sTempFileName As String
Dim sTempFileNamevbs As String
Set wsActive = ActiveSheet
ThisWorkbook.Save
'Create batch file
With wsActive
'create .vbs file for keystrokes (called in .bat file)
ExportPath = "C:\Temp\"
sTempFileNamevbs = ExportPath & Trim(.Name) & ".vbs"
iFileNumvbs = FreeFile
Open sTempFileNamevbs For Output As #iFileNumvbs
Print #iFileNumvbs, "Set WshShell = WScript.CreateObject(" & Chr(34) & "WScript.Shell" & Chr(34) & ")"
Print #iFileNumvbs, "WshShell.Run(" & Chr(34) & "C:\Users\blah.xmcd" & Chr(34) & ")"
Print #iFileNumvbs, "WScript.Sleep 10000"
Print #iFileNumvbs, "WshShell.AppActivate"; Spc(1); "WshShell"
Print #iFileNumvbs, "WScript.Sleep 5000"
Print #iFileNumvbs, "WshShell.SendKeys"; Spc(1); """^{F9}"""
'create .bat file
sTempFileName = ExportPath & Trim(.Name) & ".bat"
iFileNum = FreeFile
Open sTempFileName For Output As #iFileNum
Print #iFileNum, "#Echo off"
Print #iFileNum, "wscript"; Spc(1); """C:\Temp\Results.vbs"""
End With
Close #iFileNum
Close #iFileNumvbs
'run batch file
retVal = Shell(sTempFileName, vbHide)
'this returns an error if sTempFileName is incorrect
If retVal = 0 Then
MsgBox "An Error Occured"
Close #FileNumber
End
End If
'exit Excel using VBA command
Application.Quit
End Sub
Code corrected and now works. Thanks for everyone's input. I'm sure there is a neater solution but this does the job!
I would like to have a macro in Outlook 2010 that will run a vbscript on my local drive. Here's what I've tried.
Sub RUNvbscript()
Shell "Explorer.exe ""C:\rest of path""", 1
End Sub
That did not work, any suggestions?
You have a few options here: Shell(), the ShellExecute() API function, scripting host's WShell.Run(), etc. If you need to wait for your script to complete, however, WShell.Run() has a synchronous option, which makes it nice.
strPath = "c:\folder\myscript.vbs"
Set objShell = CreateObject("WScript.Shell")
' Run synchronously...
objShell.Run Chr(34) & strPath & Chr(34), 1, True
' Or, run asynchronously...
objShell.Run Chr(34) & strPath & Chr(34), 1, False
With the others, you'd need to use WaitForSingleObject or some other polling mechanism to determine when the script completes.