I'm trying to write code that periodically puts/makes sure a program is in front of all the others. To test this I have used Notepad.
This code only seems to work if I open a new program in front of Notepad - and not if I open a program; then start to execute my code; then put the other already open program in front of notepad. In this case notepad only blinks orange in the taskbar.
Can anybody help me with this?
Sub test()
Dim vPID As Variant
vPID = Shell("notepad.exe", vbMaximizedFocus)
AppActivate vPID
'Notepad opens, I put another program in front of it
Application.Wait (Now + TimeValue("00:00:05"))
'I want Notepad back in front again:
Dim HWND As Long
Dim SetFocus As Long
HWND = FindWindow("Notepad", vbNullString)
SetFocus = SetForegroundWindow(HWND)
Application.Wait (Now + TimeValue("00:00:05"))
'Close Notepad
Call Shell("TaskKill /F /PID " & CStr(vPID), vbHide)
End Sub
Related
I have to run an .exe in VBA Excel and write in the input window "in.txt" "out.txt" in order to make the process automatic inside a macro. I tried to use shell but it works asynchrounous and I also don't know how to tell her to write inside the .exe.
I've also tried with SendKeys but apperently it doesen't work.
How could I make the VBA calling my .exe, open it, write inside the command window of the .exe, wait for the output and use it to go on?
thank you in advance
here are two attempts (both failed):
Sub write()
prog = Shell("C:\Users\arancia\Pictures\Camera Roll\axtur\axtur\AXTUR_64.exe", 1)
Application.Run "'AXTUR&EXCEL.xlsm'!inserisci_dati_input"
SendKeys.send "in.txt~", True
SendKeys.send "out.txt~", True
SendKeys "%{F4}", True
End Sub
Sub StartExeWithArgument()
Dim strProgramName As String
Dim strArgument As String
strProgramName = "C:\Users\arancia\Pictures\Camera Roll\axtur\axtur\AXTUR_64.exe"
strArgument = "in.txt~out.txt~"
Call Shell("""" & strProgramName & """ """ & strArgument & """", vbNormalFocus)
End Sub
One solution would be to write a batch file that includes all the parameters and then run the batch.
I have used WshShell (Windows scripting host) to run batch files to do what you want in the past but WshShell does not work on our computers since the Nov 2020 updates. WshShell allows you to wait for the outcome of the external program.
One way I found to go around it is to write a simple text file at the end of the batch and wait for it to show up. This is crude but it works.
In the code below, I write a simple batch file in the folder of the Excel sheet. The last line of the batch writes the content of the folder in a text file. The Do Until loop waits for the text file to show up in 1 second increments. When the code resumes after the loop, the text file is deleted. If you write the command line you would type in cmd instead of "echo Hello World" this should work.
You need to reference the Microsoft Scripting Runtime (scrrun) to use the file system object.
Good Luck!
Public Sub RunBatch()
Dim i As Integer
Dim k As Integer
Dim xlWB As Workbook
Dim fso1 As New FileSystemObject
Dim BatFile As Object
Dim IsDone As Boolean
Dim OutFileName As String
Set xlWB = ThisWorkbook
OutFileName = xlWB.Path & "\" & "HW.bat"
Set BatFile = fso1.CreateTextFile(OutFileName)
BatFile.WriteLine "cd /d " & xlWB.Path
BatFile.WriteLine "echo Hello World"
BatFile.WriteLine "dir > Done.txt"
BatFile.Close
IsDone = False
Call Shell(OutFileName, vbNormalFocus)
Do Until IsDone
If fso1.FileExists(xlWB.Path & "\Done.txt") Then IsDone = True
Application.Wait (Now + TimeValue("00:00:01"))
Loop
fso1.DeleteFile (OutFileName)
End Sub
I am trying to automate a process which involves using VBA in Excel to open a file on a remote desktop through RDP. I have successfully managed to log into RDP but am now struggling to open the file consistently. I wrote some code relying on SendKeys that maybe works 10% of the time but am looking for something more robust.
Sub RunRDP()
Dim RetVal As Variant
Dim Target As String
Dim Sheet As Variant
'Log-in info
Target = "AAAA.com"
UserName = "BBBBBB\CCC"
Pwd = "DDDDD"
'Connect to Remote Desktop
RetVal = Shell("cmdkey /generic:""" & Target & """ /user:""" & UserName & """ /pass:""" & Pwd & """", 3)
RetVal = Shell("c:\Windows\System32\mstsc.exe /v:" & Target, 3)
'Press yes through cert errors
Do
If InStr(ActiveWinTitle, "Remote Desktop Connection") > 0 Then
Application.SendKeys "y", True
End If
Loop Until InStr(ActiveWinTitle, "AAAA") > 0
Application.Wait (Now + TimeValue("00:00:03"))
If InStr(ActiveWinTitle, "Remote Desktop Connection") > 0 Then
AppActivate "AAAAA.com - Remote Desktop Connection"
Else
AppActivate "AAAAA.com"
End If
Application.Wait (Now + TimeValue("00:00:07"))
The above code works as expected. ActiveWinTitle is a function to grab the current window's caption, see below:
Public Declare Function GetForegroundWindow Lib "user32" _
() As Long
Public Declare Function GetWindowText Lib "user32" _
Alias "GetWindowTextA" (ByVal HWnd As Long, _
ByVal lpString As String, ByVal cch As Long) As Long
Public Function ActiveWinTitle() As String
Dim WinText As String
Dim HWnd As Long
Dim L As Long
HWnd = GetForegroundWindow()
WinText = String(255, vbNullChar)
L = GetWindowText(HWnd, WinText, 255)
ActiveWinTitle = Left(WinText, InStr(1, WinText, vbNullChar) - 1)
End Function
The below code is what I've tried to make work for opening the file. Its explanation in English follows:
Application.SendKeys "RE", True
Application.SendKeys "~", True
Application.Wait (Now + TimeValue("00:00:01"))
Application.SendKeys "{F4}", True
Application.Wait (Now + TimeValue("00:00:01"))
Application.SendKeys "{BS}{BS}{BS}{BS}{BS}{BS}{BS}{BS}{BS}{BS}{BS}F:\[**FILEPATH HERE**]~", True
Type RE on the desktop to highlight the Recycle Bin
Press Enter to open the Recycle Bin (to get to a file explorer window)
Wait one second
Press F4 to move cursor to address bar
Wait one second
Delete "Recycle Bin" from the address bar, write in the correct filepath, and press Enter
Obviously this is extremely unreliable and is the reason I'm looking for something better.
This code is something I'm using for work and am looking to share with my colleagues - I am not able to download any programs to use instead of VBA because of this.
I have looked at these questions without much avail:
Script to Open a batch file on a remote computer
I am not familiar with WMI and am not sure if I would have to completely replace using RDP. I tried looking at the documentation for it and it's quite above my head.
Run a batch file on a remote desktop from VBA
This is an earlier thread from the same user. It has some dead links that I was unable to follow.
I've looked at a lot of threads that had the same unanswered question as mine. It may be a futile effort, but I'd like to know definitively if this is manageable or not. [EDIT: Some of the unanswered forum posts I've found in my research below]
https://www.office-forums.com/threads/vba-remote-desktop-connection-mstscax.2170171/
https://www.tek-tips.com/viewthread.cfm?qid=1582592
https://www.ozgrid.com/forum/forum/help-forums/excel-vba-macros/1210417-controlling-remote-desktop-from-vba
Thanks in advance for all of your help.
Would a non-programming approach help you, too?
On the remote computer, create a scheduled task which launches when someone connects to the user session.
...and simply run anything from there.
Of course, maybe you still want to reach only for advanced techniques, but sometimes they can be easily avoided only by using existing tools.
Could someone please help with problem running code below. It works when I specify only 1 filename in the Shell function but when I try a loop, whereby I want Shell to simply be a file opener of file type specified (ie .sim), the system loops endlessly; opening the .exe and presenting a dialogue box from opened executable program "file doesn't exist".
Background: I've many .sim files in a folder that I want to perform an execution using code inside loop below. Once the task for first opened .sim file is complete I want to loop through all remaining .sim files.
Xidgel I try this and it works well only once and then trying again it fails;
Sub Test1()
Dim strProgramName As String
Dim Foldername As String
Dim Fname As String
Dim wsh As Object
Set wsh = VBA.CreateObject("WScript.Shell")
Dim waitOnReturn As Boolean: waitOnReturn = False
Dim windowStyle As Integer: windowStyle = 1
strProgramName = "C:\userspath.exe"
Foldername = "C:\whatever\"
Fname = Dir(Foldername & "*.sim")
Do While Len(Fname)
wsh.Run strProgramName & " " & Foldername & Fname, windowStyle, waitOnReturn
Application.Wait Now + TimeValue("0:00:02")
SendKeys "(%)m"
Application.Wait Now + TimeValue("0:00:02")
SendKeys "{DOWN 13}"
Application.Wait Now + TimeValue("0:00:02")
SendKeys "{ENTER}"
Application.Wait Now + TimeValue("0:00:02")
SendKeys "{ENTER}"
Application.Wait Now + TimeValue("0:00:02")
SendKeys "(^S)"
Application.Wait Now + TimeValue("0:00:02")
SendKeys "%{F4}"
Fname = Dir()
Loop
MsgBox "Task Complete!"
End Sub
The following code works for me (sending text and commands to a series of files edited using Notepad):
Public Sub test()
Dim strProgramName As String
Dim Foldername As String
Dim Fname As String
Dim TaskID As Variant
strProgramName = "C:\Windows\system32\notepad.exe"
Foldername = "C:\temp\"
Fname = Dir(Foldername & "*.dat")
Do While Len(Fname)
' Call Shell("""" & strProgramName & """ """ & Fname & """")
TaskID = Shell(strProgramName & " " & Foldername & Fname, vbNormalFocus)
AppActivate TaskID
Application.SendKeys "ABC" & vbCr, True ' Add some text
Application.Wait Now + TimeValue("0:00:02")
Application.SendKeys "^s", True ' CTRL-s = save
Application.Wait Now + TimeValue("0:00:02")
Application.SendKeys "%{F4}", True ' Alt-F4 = Quit
Application.Wait Now + TimeValue("0:00:02")
' Get next file
Fname = Dir()
Loop
MsgBox "Task Complete!"
End Sub
For me use of SendKeys was a little fragile. I needed the call to AppActivate to make sure the keystrokes were directed to Notepad. I first tried the Shell command without using vbNormalFocus and only some of my keystrokes made it through to Notepad. Also, when I tried to run the code from the VBA environment the keystrokes got sent to Excel, so I had to test by running from Excel.
Hope this get you started.
OK Here's a new version that opens the .exe once, opens/edits/saves/closes a series of files, then closes the .exe. I hope is closer to a solution.
Public Sub send_keys_test_2()
Dim strProgramName As String
Dim Foldername As String
Dim Fname As String
Dim TaskID As Variant
' In version 1 I tested with Notepad
' This version won't work with Notepad because it assumes
' a multiple document interface (MDI). Specifically, we want
' an .exe that can be open without having documents open. Notepad
' fails this requirement --- if you close a document in Notepad
' then the Notepad application closes too. So in this version
' I will test with MS Word.
' Modify to suit your purposes.
strProgramName = "C:\Program Files (x86)\Microsoft Office\Office14\WINWORD.exe"
' My test files are in C:\temp
' Modify to suit your purposes
Foldername = "C:\temp\"
' My test files are a series of Word Docs
' Modify to suit your purposes
Fname = Dir(Foldername & "File*.doc")
' If there are no matching files, then exit
If Len(Fname) = 0 Then Exit Sub
' Otherwise, start the .exe WITHOUT opening any files
TaskID = Shell(strProgramName, vbNormalFocus)
' Allow plenty of time for the .exe to open
Application.Wait Now + TimeValue("0:00:10")
' Make sure the keystrokes get sent to the .exe
AppActivate TaskID
Do While Len(Fname)
' Call Shell to open the first file
' In Word, send CTRL-o to display the file open dialog box
' Then send the Foldername + FName
' Then send an ENTER key to complete the file open
' Modify this to suit your purposes
Application.SendKeys "^o", True ' CTRL-o = open
Application.Wait Now + TimeValue("0:00:02")
Application.SendKeys Foldername & Fname, True ' Send the file name
Application.SendKeys "~", True ' Send {Enter} to close dialog, open file
' Now edit the file
' For demo purposes, just send a few new chars
Application.SendKeys "ABC" & vbCr, True ' Add some text
' Save the file
' In Word, send CTRL-s
' Modify to suit your purposes
Application.SendKeys "^s", True ' save
' Close the file
' In Word, send CTRL-w
' Modify to suit your purposes
Application.SendKeys "^w", True ' save
' Get next file
Fname = Dir()
Application.Wait Now + TimeValue("0:00:02")
Loop
' Send the quit command
' In Word, send Alt-F4
' Modify to suit your purposes
AppActivate TaskID
Application.Wait Now + TimeValue("0:00:02")
Application.SendKeys "%{F4}", True ' Alt-F4 = Quit
MsgBox "Task Complete!"
End Sub
Hope this helps.
I made an executable based on a Python Script that I made from a Selenium Code where I put a number and then it returns a *.pdf file. Now I'm trying to create a VBA Macro in Excel to send the ActiveCell value through the Shell Command to my application:
Sub do_it()
Dim RetVal As Variant
RetVal = Shell("C:\Users\ghost\Desktop\assist_exe\dist\assist_inputc.exe " & ActiveCell.Value, 1)
End Sub
The assist_inputc.exe opens up but the ActiveCell's value is not being captured.
i tried this:
RetVal = Shell("cmd /k C:\Users\ghost\Desktop\assist_exe\dist\assist_inputc.exe ECHO " & ActiveCell.Value, 1)
and still can´t post the value from the ActiveCell into my aplication, but, if i execute the same code without the aplication path it works fine, maybe there´s a diferent way to paste the value?
Searching related post´s i find a solution that help me in this problem :
Dim RetVal As Variant
RetVal = Shell("cmd /k C:\Users\ghost\Desktop\temp\dist\assist_empty.exe ", 1)
Application.Wait Now + TimeValue("00:00:01")
SendKeys ActiveCell.Value
SendKeys "{ENTER}"
I hope it works for someone with the same or similar problem.
I am having trouble opening my pdf file in excel. I wrote a macro to open a pdf document, copy everything and paste it into an excel workbook but I cant get the pdf file to open. I keep getting the 1004 runtime error. Any ideas of help would be appreciated. Here is what I have tried so far:
Public Sub PDFCopy()
Dim o As Variant
Dim App As AcroPDDoc
Worksheets("Sheet3").Range("A2").Activate
'App.Open ("C:\NetworkDiagrams\100-Viking.pdf")
o = Shell("calc.exe", vbNormalNoFocus)
' ActiveWorkbook.FollowHyperlink ("C:\NetworkDiagram\100-Viking.pdf")
Application.Wait Now + TimeValue("00:00:05")
SendKeys ("^a")
SendKeys ("^c")
SendKeys "%{F4}"
Worksheets("Sheet3").Range("A2").Activate
SendKeys ("^v")
End Sub
All three methods have given me the same runtime error. I am out of ideas.
There are two ways to do this.
First, you need to know what is installed in your system.
Acrobat is different from Acrobat or Adobe Reader.
Here's the code if you only have Acrobat Reader. You use the Shell function.
Then to copy the content of PDF, you use the SendKeys.
Kind of dirty code and not 100% reliable but I can say that it still works.
Sub Get_Pdf()
Dim XLName As String, PDFPath As String, READERPath As String
Dim OpenPDF, sh As Worksheet
XLName = ThisWorkbook.Name
Set sh = Thisworkbook.Sheets(1)
PDFPath = Application.GetOpenFilename(filefilter:="PDF file (*.pdf), *.pdf")
If UCase(PDFPath) = "FALSE" Then Exit Sub
'~~> Below path differs depending Adobe version and installation path
READERPath = "C:\Program Files\Adobe\Reader 11.0\Reader\AcroRd32.exe "
Shell READERPath & PDFPath, vbNormalFocus: DoEvents
Application.Wait Now + TimeValue("00:00:2")
SendKeys "^a", True
Application.Wait Now + TimeValue("00:00:2")
SendKeys "^c"
Application.Wait Now + TimeValue("00:00:2")
Windows(XLName).Activate
sh.Paste sh.Range("A1")
SendKeys "%{F4}", True
End Sub
If however you have the Acrobat Installed, refer to this post and check the link posted on the correct answer.
An update was posted on the link and it covers opening PDF even if only ADOBE reader is installed.
Not sure if this will work for you, but it opens the PDF and copies it in A2; hopefully someone can chime in with something a little cleaner.
Public Sub PDFCopy()
'Filepath for your Adobe reader
MyPath = "C:\Program Files\Adobe\Reader 10.0\Reader\AcroRd32.exe"
'Filepath for your PDF to open
MyFile = "C:\Documents\test.pdf"
Shell MyPath & " " & MyFile, vbNormalFocus
SendKeys ("^a")
SendKeys ("^c")
SendKeys "%{F4}"
Windows("Test.xlsm").Activate
Worksheets("Sheet2").Activate
ActiveSheet.Range("A2").Select
SendKeys ("^v")
End Sub