put batch file command into VBA Excel - vba

Here is batch file code:
#echo off >summary.txt (
for %%F in (*chkpackage.log) do findstr /l %1 "%%F" nul||echo %% F:N/A:N/A:N/A:N/A:N/A:N/A:N/A:N/A:N/A:N/A:N/A:N/A:N/A:N/A:N/A:N/A:N/A:N/A)
and here is the code in VBA Excel calling the batch file:
FileSet = Sheet1.Range("C13")
txtFpath = Sheet1.Range("C7").Value
FilePath = txtFpath & "\res.bat"
ChDrive "D"
RSP = Shell(Environ$("COMSPEC"), vbNormalFocus)
Application.Wait Now + TimeValue("00:00:03")
SendKeys "CD " & txtFpath & "{ENTER}", True
Application.Wait Now + TimeValue("00:00:03")
SendKeys "start " & FilePath & " " & FileSet & "{ENTER}", True
Application.Wait Now + TimeValue("00:00:03")
SendKeys "exit " & "{ENTER}", True
Application.Wait Now + TimeValue("00:00:03")
SendKeys "exit " & "{ENTER}", True
But I don't want to use a batch file. I want to change it into command to use on VBA.
So i can use only VBA and run command line instead of using VBA to call batch and command line.
Easy explanation is I want to put that command in batch file into Excel-VBA and run it by using VBA call cmd and auto input that command to cmd like that Sendkeys code.

You can add a reference to the Microsoft Scripting Runtime (Tools -> References from the VBA IDE), which provides the FileSystemObject and allows you to do the following:
Dim fso As New FileSystemObject
Dim fle As Variant
For Each fle In fso.GetFolder(txtFpath).Files
'processing here
Next
You can limit the files to a particular pattern using the Like operator:
For Each fle In fso.GetFolder(txtFpath).Files
If fle.Name Like "*chkpackage.log" Then
'processing here
End If
Next
You can use the OpenAsTextStream method to get a TextStream object, and the ReadAll method to read the file contents:
For Each fle In fso.GetFolder(txtFpath).Files
If fle.Name Like "*chkpackage.log" Then
Dim txt As TextStream, contents As String
Set txt = fle.OpenAsTextStream(ForReading)
contents = txt.ReadAll
txt.Close
'process contents of file here
End If
Next
You can use Split(contents, vbCrLf) to split the contents into an array of lines before parsing (use vbLf or vbCr if the line delimiter is Unix/Mac and not Windows).
Alternatively, you can use the ReadLine method to read the file line by line. You need to check the AtEndOfStream property to ensure that you're not trying to read past the end of the file:
'Within the For Each loop
Dim txt As TextStream, currentLine As String
Set txt = fle.OpenAsTextStream(ForReading)
Do While Not txt.AtEndOfStream
currentLine = txt.ReadLine
'process current line here
Loop
txt.Close

Related

method run object iwshshell3 failed vba

I am trying to automate file upload on chrome, getting error here :method run object iwshshell3 failed" please help:
Dim Customer_rates As String
Dim WshShell As Object
Customer_rates = "D:\FX Exch. Rates\2022-Feb-24 1707\MP_customer_exchange_rates_sample.xlsx"
Set WshShell = CreateObject("WScript.Shell")
WshShell.Run "cmd.exe/c echo" & Customer_rates & "| clip", vbNormal, True
WshShell.SendKeys "^{v}"
Application.Wait DateAdd("S", 2, Now)
WshShell.SendKeys "{ENTER}"
Think about how this would appear in the console. The file path has spaces. So it will require quotes around it when you run it. Something like:
WshShell.Run "cmd.exe/c echo" & chr(34) & Customer_rates & chr(34) & "| clip", vbNormal, True
Thansk guys i did a workaround of cmd with this sub and it semms to work:
Sub StoreData()
Dim varText As String
Dim objCP As Object
varText = "D:\FX Exch. Rates\2022-Feb-24 1707\MP_customer_exchange_rates_sample.xlsx"
Set objCP = CreateObject("HtmlFile")
objCP.ParentWindow.ClipboardData.SetData "text", varText
End Sub
Try to always work with absolute paths (program and arguments).
Be aware of quotes. I preferably use chr(13)

Running dir in command prompt from vba

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

"WshShell The system cannot find the file specified Error 80070002"

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

VBA - creating .vbs and .bat to issue keystrokes to external program

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!

Can't delete VBScript file after running it

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.