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
Related
I have the following code:
Private Sub cmdExportTERNAME_Click()
On Error Resume Next
Me.MsgFld = "Please wait... exporting TERNAME file."
Dim expLoc As String
Dim xFile As String, myFile As String
Dim myFlag As Integer
expLoc = "I:\Investigative Names\" ' PRD
xFile = Dir(expLoc & "NAME - ForUpload.txt", vbDirectory)
myFile = "NAME-ForUpload.txt"
myFlag = StrComp(xFile, myFile)
If myFlag <> -1 Then
Kill expLoc & "NAME-ForUpload.txt"
End If
' Export text files for upload
DoCmd.TransferText acExportFixed, "SpecTERNAME", "qry_TERNAME", expLoc & "NAME-ForUpload.txt"
xFile = Dir(expLoc & "TNAME-ForUpload.txt")
myFile = "NAME-ForUpload.txt"
myFlag = StrComp(xFile, myFile)
If myFlag <> -1 Then
GoTo ContinueProcessing1
Else
MsgBox "The program was not able to export the NAME file for upload." & Chr(13) & Chr(13) & "Please notify IS Department.", vbCritical, "ERROR MESSAGE BOX"
GoTo exitRTN
End If
ContinueProcessing1:
exitRTN:
End Sub
So I have 2 more of these subroutines with different text files which work fine but this block of code doesn't find xFile, it return a empty string which causes the program to display the message box error. I can't figure out why the same code with different text file works before it reaches this code. The weird thing is it sometimes finds the correct xFile name in debug mode but not when run normally. Can someone help me figure this out?
Thanks
I am trying to work on a code that will give me the user activity on the userform that I have created. I want to keep this logs file in shared drive if possible.
below is my code, not getting any records in logs folder
Sub LogInformation(LogMessage As String)
Const LogFileName As String = "D:\FOLDERNAME\TEXTFILE.LOG"
Dim FileNum As Integer
FileNum = FreeFile ' next file number
Open LogFileName For Append As #FileNum ' creates the file if it doesn't exist
Print #FileNum, LogMessage ' write information at the end of the text file
Close #FileNum ' close the file
End Sub
Public Sub DisplayLastLogInformation()
Const LogFileName As String = "D:\FOLDERNAME\TEXTFILE.LOG"
Dim FileNum As Integer, tLine As String
FileNum = FreeFile ' next file number
Open LogFileName For Input Access Read Shared As #f ' open the file for reading
Do While Not EOF(FileNum)
Line Input #FileNum, tLine ' read a line from the text file
Loop ' until the last line is read
Close #FileNum ' close the file
MsgBox tLine, vbInformation, "Last log information:"
End Sub
Sub DeleteLogFile(FullFileName As String)
On Error Resume Next ' ignore possible errors
Kill FullFileName ' delete the file if it exists and it is possible
On Error GoTo 0 ' break on errors
End Sub
Private Sub Workbook_Open()
LogInformation ThisWorkbook.Name & " opened by " & _
Application.UserName & " " & Format(Now, "yyyy-mm-dd hh:mm")
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'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.
I am writing a function in excel vba
Function WriteByteArray(vData As Variant, sFileName As String, Optional bAppendToFile As Boolean = False) As Boolean
Dim iFileNum As Integer, lWritePos As Long
Debug.Print " --> Entering WriteByteArray function with " & sFileName & " file to write."
On Error GoTo ErrFailed
If bAppendToFile = False Then
If Len(Dir$(sFileName)) > 0 And Len(sFileName) > 0 Then
'Delete the existing file
VBA.Kill sFileName
End If
End If
iFileNum = FreeFile
Debug.Print "iFileNum = " & iFileNum
'Open sFileName For Binary Access Write As #iFileNum
Open sFileName For Binary Lock Read Write As #iFileNum
If bAppendToFile = False Then
'Write to first byte
lWritePos = 1
Else
'Write to last byte + 1
lWritePos = LOF(iFileNum) + 1
End If
Dim buffer() As Byte
buffer = vData
Put #iFileNum, lWritePos, buffer
WriteByteArray = True
Exit Function
ErrFailed:
Debug.Print "################################"
Debug.Print "Error handling of WriteByteArray"
Debug.Print "################################"
FileWriteBinary = False
Close iFileNum
Debug.Print Err.Description & "(" & Err.Number & ")"
End Function
I am getting a permission denied error in VBA.Kill and Open Can any one help me???
You are forgetting to close the file when the function returns, you currently only do so when there is an error.
The file handle persists between runs of you code so when you re-run it you attempt to operate on a file that is already open and explicitly locked, causing an error.