I have been successfully running my r script in Excel 2010 & Windows 7 using vba for a long time. Then I had to use another computer which has Excel 2013 & Windows 8 installed. It gets me the following error:
Method 'Run' of object 'IWshShell3' failed
This is the code that runs in Excel 2010:
Dim shell As Object
Set shell = VBA.CreateObject("WScript.Shell")
Dim waitTillComplete As Boolean: waitTillComplete = True
Dim style As Integer: style = 0
Dim errorCode As Integer
Dim var1 As String
Dim PATH As String
var1 = Replace(Replace(ThisWorkbook.PATH, "\", "/") & "/", " ", "_z9z_")
PATH = "C:\PROGRA~1\R_App\bin\x64\RScript """ & "C:\JF\Code A\dvlp.R"" " & var1 & " " & 2500
errorCode = shell.Run(PATH, style, waitTillComplete)
This same code doesn't run in the other computer I mentioned.
I have gone through other questions in stackoverflow stating the same issue, but the solutions there hasn't helped me. For example, I already use double quotes and I have tried getting rid of them.
Any ideas?
Consider a cleaner build of command line Rscript call that can handle spaces in names which may be the issue here. Below also integrates proper error handling.
Sub Run_R_Script()
On Error Goto ErrHandle
Dim shell As Object
Dim waitTillComplete As Boolean: waitTillComplete = True
Dim style As Integer: style = 0
Dim errorCode As Integer
Dim args(0 To 3) As String
Dim rCommand As String
Dim i As Integer
args(0) = "C:\PROGRA~1\R_App\bin\x64\RScript"
'args(0) = "Rscript.exe" ' IF R BIN FOLDER IN PATH ENV VARIABLE
args(1) = "C:\JF\Code A\dvlp.R"
args(2) = Replace(Replace(ThisWorkbook.PATH, "\", "/") & "/", " ", "_z9z_")
args(3) = 2500
rCommand = args(0)
For i = 1 To UBound(args)
rCommand = rCommand & " """ & args(i) & """"
Next i
Debug.Print rCommand ' CHECK COMMAND LINE CALL
Set shell = VBA.CreateObject("WScript.Shell")
errorCode = shell.Run(rCommand, style, waitTillComplete)
ExitHandle:
Set shell = Nothing ' RELEASE ALL set OBJECTS
Exit Sub
ErrHandle:
MsgBox Err.Number & " - " & Err.Description, vbCritical
Resume ExitHandle
End Sub
Related
I tried a number of ways to construct the string to call notepad++ with a filename.
I need to also utilize the '-n' parameter for notepad++ to open a file at a particular line. Simple cases work, however when concatenating strings for the path I have been getting runtime 424 errors.
This is in VBA in Excel.
Option Explicit
Sub GoToLine()
Dim strNotePadPath As String
strNotePadPath = "C:\Program Files\NotePad++\notepad++.exe "
Dim strSourceBasePath As String
strSourceBasePath = "C:\VBAExcelTest\TestSource"
Dim strSourcePathFinal As String
strSourcePathFinal = strSourceBasePath & Cells(Selection.Row, 1).Value
Dim strLineNumber As String
strLineNumber = " -n" & Cells(Selection.Row, 2).Value
Dim retval As Variant
'This works: retval = Shell("C:\Program Files\NotePad++\notepad++.exe C:\VBAExcelTest\TestSource\SourceA\FakeSourceA.txt -n1", 1)
'I get a runtime error 424 on the Call Shell line below
If Selection.Row.Count = 1 Then
Call Shell("""" & strNotePadPath & strSourcePathFinal & strLineNumber & """", vbNormalFocus)
End If
End Sub
Sometimes a token-replacement approach is easier to manage when dealing with escaped quotes etc:
Sub GoToLine()
Dim cmd As String, retval As Variant, rw As Range
Set rw = Selection.Cells(1).EntireRow
cmd = Tokens("""{1}"" ""{2}"" {3}", _
"C:\Program Files\NotePad++\notepad++.exe", _
"C:\Tester\tmp\" & rw.Cells(1).Value, _
"-n" & rw.Cells(2).Value)
Debug.Print cmd
Shell cmd, vbNormalFocus
End Sub
'replace tokens in the first argument, using the rest of the arguments
Function Tokens(txt As String, ParamArray args() As Variant) As String
Dim i As Long, t As Long
t = 0
For i = 0 To UBound(args)
t = t + 1
txt = Replace(txt, "{" & t & "}", args(i))
Next i
Tokens = txt
End Function
I have an Excel VBA script that takes two files and performs a Relace function on one column. This all works fine if i step through it slowly. But if i run it without any breaks then it produces a file that still contains the characters that i replaced ?
I have added "Kill" file commands to ensure that i am creating new files, even my output file i am using a datestamp to ensure its a unique file then renaming it. But i then upload it to an FTP server as part of the script and when viewing what i have uploaded, it has the characters i removed ? even though when i view my output file before uploading, it doesnt ?????
Private Sub OutputFile()
Dim strNowDifferentiator As String
Dim strPath As String
Dim AgentStr As String
Dim AccessTypeLong As Long
Dim ProxyNameStr As String
Dim ProxyBypassStr As String
Dim FlagsLong As Long
Dim InternetSessionLong As Long
Dim ServiceLong As Long
Dim ContextLong As Long
Dim FTPSessionLong As Long
Dim FailIfExistsBool As Boolean
Dim FlagsAndAttributesLong As Long
Dim SomeThingLong As Long
Dim MyInternetHandleLong As Long
Dim MyFTPHandleLong As Long
Dim SomeInteger As Integer
Dim FTPSuccessBool As Boolean ' Did the FTP download work?
AgentStr = "GreenTreeTest" ' can be whatever
AccessTypeLong = 0 ' zero appears to work fine
ProxyNameStr = "" ' nul works fine here
ProxyBypassStr = "" ' nul works fine here
FlagsLong = 0 ' zero appears to work fine
MyInternetHandleLong = InternetOpen(AgentStr, AccessTypeLong, ProxyNameStr, ProxyBypassStr, FlagsLong)
' MsgBox MyInternetHandleLong
'MyInternetHandleLong is obtained above
ServiceLong = 1 ' this for the FTP service (2 = gopher, 3 = http)
FlagsLong = 0 ' 0 appears to work fine here
ContextLong = 0 ' 0 appears to work fine here
MyFTPHandleLong = InternetConnect(MyInternetHandleLong, "mercury.ingrammicro.com", 21, "CDW_PRICEFILE", "XXXXX", ServiceLong, FlagsLong, ContextLong)
strNowDifferentiator = Replace(Replace(Now(), "/", " "), ":", "")
strPath = "\\Sov-fs3\Departmental\Supply Chain\Feeds\"
Application.DisplayAlerts = False
Call subUpdateProgressLabel("Producing the output file...")
'DeleteFile ("C:\temp\CDWFeed.csv")
DeleteFile (strPath & "CDWFeed.csv")
ThisWorkbook.Sheets("Output").Copy
'ActiveWorkbook.SaveAs Filename:="C:\temp\CDWFeed.csv", FileFormat:=xlCSV, CreateBackup:=True
ActiveWorkbook.SaveAs Filename:=strPath & "CDWFeed" & strNowDifferentiator & ".csv", FileFormat:=xlCSV, CreateBackup:=True
ActiveWorkbook.Close SaveChanges:=False
Name strPath & "CDWFeed" & strNowDifferentiator & ".csv" As strPath & "CDWFeed.csv"
Call FtpDeleteFile(MyFTPHandleLong, "CDWFeed.csv")
Application.DisplayAlerts = True
Sheets("Output").Cells.Clear
Call subUpdateProgressLabel("Uploading file to Ingram fTP...")
'removed SHELL as doesnt work well within CITRIX
'Shell ("ftp -s:" & Chr(34) & "\\Sov-fs3\Departmental\Supply Chain\Feeds\script.txt" & Chr(34) & " mercury.ingrammicro.com")
Call FtpUpload("\\Sov-fs3\Departmental\Supply Chain\Feeds\CDWFeed.csv", "CDWFeed.csv", "mercury.ingrammicro.com", 21, "CDW_PRICEFILE", "XXXXXX")
End Sub
I want to open an attachment from Lotus Notes with VBA.
The Problem is that I don't get the path out of Lotus Notes.
I would be very thankful if you can give me a code, with how I can open this path without hardcoding it.
Here is the complete Code which does not work...
Function OpenURL(URL As String, WindowState As W32_Window_State) As Boolean
'Opens passed URL with default application, or Error Code (<32) upon error
Dim lngHWnd As Long
Dim lngReturn As Long
lngReturn = ShellExecute(lngHWnd, "open", URL, vbNullString, _
vbNullString, WindowState)
OpenURL = (lngReturn > 32)
End Function
Sub OpenLotusNotes()
Dim objNotesSession As Object
Dim objNotesFile As Object
Dim objNotesDocument As Object
Dim objNotesField As Object
Dim objNotesUIWorkSpace As Object
Dim objNotesView As Object
Set objNotesSession = CreateObject("Notes.NotesSession")
Set objNotesFile = objNotesSession.GETDATABASE("ATLAS40", "ACITF\PRODUCTION\USN\ePayable.nsf")
'("Server", "Datenbank")
Set objNotesUIWorkSpace = CreateObject("Notes.NotesUIWorkSpace")
Set i = Sheet1.Range("B20")
Dim DocNum As Variant
Dim DocName As Variant
Set objNotesView = objNotesFile.GetView("1.CheckView")
Set objNotesDocument = objNotesView.GetFirstDocument
Dim body As Variant
Dim ms As String
ms = ""
If Not objNotesDocument Is Nothing Then
'initial set
DocNum = objNotesDocument.InvoiceNumber
DocName = objNotesDocument.InvoiceDocumentNumber
Dim DocFound As Boolean
DocFound = False
While Not DocFound = True
DocNum = objNotesDocument.InvoiceNumber
DocName = objNotesDocument.InvoiceDocumentNumber
If DocNum(0) = i Then
ms = "You are about to open the attachement located in " & DocNum(0) & " " & DocName(0) & " in The Way we do things database from Database Server " & objNotesFile.server & " with Database File name " & objNotesFile.Filename & "."
MsgBox (ms)
DocFound = True
Set body = objNotesDocument.getfirstitem("$FILE")
'subject der mail ermitteln
For Each obj In body.embeddedobjects
'MsgBox (Environ("TEMP") & "\" & obj.Name)
'MsgBox (obj.Name)
Call obj.ExtractFile(Environ("TEMP") & "\" & obj.Name)
OpenURL "file://" & Environ("TEMP") & "\" & obj.Name, Show_Maximized
Next
End If
Set objNotesDocument = objNotesView.GetNextDocument(objNotesDocument)
Wend
End If
You can't open the file by accessing the $File item, so even if you had the correct syntax (using GetFirstItem("$File)) it would still not work.
You need to use objNotesDocument.EmbeddedObjects() This will return an array of NotesEmbeddedObject objects. If there's only one file attachment in the document, there will be only one element in the array. You can use the ExtractFile method of the NotesEmbeddedObject class to save a copy of the file to the filesystem, and you can open it from there.
I'm needing to implement a macro that runs after autoit and finished running the program it runs the rest of the macro.
I tried the Shellandwait(), but I did not find documentation explaining about it.
I took other examples of code that forum and got this:
Sub autoit()
Dim hProcess As Long
Dim xPath As String
Dim wsh As Object
Dim waitOnReturn As Boolean: waitOnReturn = True
Dim windowStyle As Integer: windowStyle = 1
Set wsh = CreateObject("WScript.Shell")
xPath = Application.ActiveWorkbook.Path
hProcess = wsh.Run("D:\Program Files\autoit-v3\install\AutoIt3_x64.exe " _
& xPath & "\leandro.au3", 0, True)
Workbooks.Open (xPath & "\Mudança " & Format(Date, "dd_mm_yyyy") & ".csv")
End Sub
When I run it returns me this error:
"Run-time error '-2147024894 (80070002)': Method 'Run' of object 'IWshShell3' failed"
I do not know what it means and I have no idea solution.
If xPath has any spaces in it you will need to wrap the expression in quotes.
Try something like this instead:
xPath = ActiveWorkbook.Path
With CreateObject("WSCript.Shell")
.Exec "CMD /C START /WAIT ""D:\Program Files\autoit-v3\install\AutoIt3_x64.exe"" """ & xPath & "\leandro.au3"""
End With
Let me share two examples of VBA code for capturing the output stream from the AutoIt script (reads from the STDOUT stream)
VBA code:
Dim sFilePath As String
Dim objShell As Object, objCmdExec
sFilePath = String(1, 34) & Application.ActiveWorkbook.path & Application.PathSeparator & "test0.au3" & String(1, 34)
Set objShell = CreateObject("WScript.Shell")
Set objCmdExec = objShell.exec("""C:\Program Files (x86)\AutoIt3\AutoIt3.exe"" " & sFilePath)
MsgBox (objCmdExec.StdOut.ReadAll)
This is the AutoIt script for the first test (test0.au3):
Global $iPID = Run("notepad.exe", "", #SW_SHOWMAXIMIZED)
WinWait("[CLASS:Notepad]", "", 10)
Sleep(2000)
Send("Hello")
Sleep(1000)
ProcessClose($iPID)
ConsoleWrite("Done" & #CRLF)
Another option i'm finding useful is this vba class:
VBA Run Application - Capture Output. Author: dmaruca. Last updated 2012
Here an example:
Dim sFilePath As String
sFilePath = ThisWorkbook.path & Application.PathSeparator & "test.au3"
Dim RunApp As New CRunApp
RunApp.Command = "C:\Program Files (x86)\AutoIt3\AutoIt3.exe"
RunApp.AddParamater sFilePath
RunApp.AddParamater "Buenos días"
MsgBox RunApp.RunAppWait_CaptureOutput()
And the script for testing (test.au3):
MsgBox(4096, 'AutoIt MsgBox', $CmdLine[1])
ConsoleWrite($CmdLine[1] & #CRLF & "From: " & #ScriptName)
I would like to write a function to would allow me to use Print #Debug, "text" throughout my future modules to collect debug statements.
Sub output_debug()
Dim WshShell As Object
Dim Desktop As String
Dim Debug As Integer
Debug = FreeFile()
Set WshShell = CreateObject("WScript.shell")
Desktop = WshShell.specialfolders("Desktop")
Open Desktop & "\VBA_output.txt" For Output As #Debug
Print #Debug, "test"
Close #Debug
End Sub
How can I move from the above, to defining a function that would allow me to use call output_debug() in a module so all my Print #Debug, would print to that file ? I would imagine I need to create another function called close_output() that has close #Debug
I did something like this in the past. Here is what I came up with. It relies on having a reference to Microsoft Scripting Runtime in any project that uses it. You can store the following subs in a module e.g. DebugLogger (which is what I use) that can be first exported then imported into any module that you want to have this functionality. It mimics the behavior of Debug.Print but sends the output to a file whose name is a function of the workbook's name. I toyed with the idea of time-stamping individual entries but rejected the idea as being too far from the functionality of Debug.Print (I do, however, time stamp the date of creation). Once you import the module and establish the right reference then you can just use DebugLog anywhere you would have used DebugPrint. As a default it also prints to the debug window. You can drop that part of the code entirely or switch what the default is.
Function GetFullDebugName() As String
'This function returns a string of the form
'*xldebug.txt, where *.* is the full name of the workbook
Dim MyName As String
Dim NameParts As Variant
MyName = ThisWorkbook.FullName
NameParts = Split(MyName, ".")
GetFullDebugName = NameParts(0) & "xldebug.txt"
End Function
Sub CreateDebugFile()
'file created in same directory as
'calling workbook
Dim DebugName As String
Dim fso As FileSystemObject
Dim MyStream As TextStream
Set fso = New FileSystemObject
DebugName = GetFullDebugName
Set MyStream = fso.CreateTextFile(DebugName)
MyStream.WriteLine "This debug file was created " _
& FormatDateTime(Date) _
& " at " & FormatDateTime(Time)
MyStream.Close
End Sub
Sub DebugLog(DebugItem As Variant, Optional ToImmediate As Boolean = True)
Dim DebugName As String
Dim fso As FileSystemObject
Dim MyStream As TextStream
Set fso = New FileSystemObject
DebugName = GetFullDebugName
'check to see if DebugFile exist
'if not, create it:
If Not fso.FileExists(DebugName) Then CreateDebugFile
Set MyStream = fso.OpenTextFile(DebugName, ForAppending)
MyStream.WriteLine DebugItem
MyStream.Close
If ToImmediate Then Debug.Print DebugItem
End Sub
Try a subroutine like this...
It will log text to a text file with a date stamp, so new file new day.
You have an option to pass it the ERR object if you trap the error in your code and it will log the error message with a highlight.
call debuglog("my log entry")
call debuglog("my log entry",err)
Public Sub DebugLog(sLogEntry As String, Optional ByVal oErr As Object)
' write debug information to a log file
Dim iFile As Integer
Dim sDirectory As String
Dim errNumber, errDescription As Variant
Dim l As Integer
If Not oErr Is Nothing Then
errNumber = oErr.Number
errDescription = oErr.Description
l = IIf(Len(errDescription) > Len(sLogEntry), Len(errDescription), Len(sLogEntry))
End If
On Error GoTo bail
sfilename = VBA.Environ("Homedrive") & VBA.Environ("Homepath") & "\My Documents\Debuglog" & "\debuglog" & Format$(Now, "YYMMDD") & ".txt"
iFile = FreeFile
Open sfilename For Append As iFile
If Not oErr Is Nothing Then
sLogEntry = "/" & String(5 + (l - Len(sLogEntry)), "-") & " " & sLogEntry & " " & String(5 + (l - Len(sLogEntry)), "-") & "\"
Print #iFile, Now; " "; sLogEntry
Print #iFile, Now; " "; errNumber
Print #iFile, Now; " "; errDescription
Print #iFile, Now; " "; "\" & String(Len(sLogEntry) - 2, "-") & "/"
Else
Print #iFile, Now; " "; sLogEntry
End If
bail:
Close iFile
End Sub
example logfile output
27/03/2015 10:44:27 -- COMIT Form Initialize - Complete
27/03/2015 10:44:27 - COMIT Active
27/03/2015 10:44:34 /----- -- Error Populating Opportunity Form: frmBluesheet.PopulateForm() -----\
27/03/2015 10:44:34 381
27/03/2015 10:44:34 Could not get the Column property. Invalid property array index.
27/03/2015 10:44:34 \-----------------------------------------------------------------------------/