My code runs a model in R directly from Excel.
I want to simplify installation so instead of:
path = """C:\Program Files\R\R-4.1.1\bin\Rscript.exe"" C:\Users\diego\OneDrive\Otros\Escritorio\ProgramacionSemanal\ProgramacionSemanal.R"
I want to retrieve Rscript.exe and ProgramacionSemanal.R path directly from cell values in the same workbook.
I tried to replicate what I had before using the cell values:
Sub RunRscript()
Dim shell As Object
Set shell = VBA.CreateObject("WScript.Shell")
Dim waitTillComplete As Boolean: waitTillComplete = True
Dim style As Integer: style = 1
Dim errorCode As Integer
Dim path As String
pathRscript = Sheets("Configuracion").Range("B17")
pathForecast = Sheets("Configuracion").Range("B11")
path = """""""" & pathRscript & """""" & " " & pathForecast & """"
errorCode = shell.Run(path, 0, waitTillComplete)
It was a matter of "". Here's my solution:
path = """" & pathRscript & """" & " " & pathForecast & """"
Related
I'm trying to pass an array from Excel VBA to R using a shell. It works with a single argument, but my code crashes in VBA if I try to pass an array to R.
My VBA code:
Sub test()
Dim oShell As Object
Dim oExec As Object
Dim oOutput As Object
Dim waitTillComplete As Boolean: waitTillComplete = True
Dim style As Integer: style = 1
Dim errorCode As Integer
Dim path As String
Dim var1
Dim var2
Set oShell = VBA.CreateObject("WScript.Shell")
var1 = ThisWorkbook.Sheets("Offerte").Range("B9").Value
var2 = ThisWorkbook.Sheets("Offerte").Range("B10:B11").Value
path = """C:\Program Files\R\R-3.5.1\bin\x64\rscript.exe""" & """S:\Test2.R """ & " " & var1 & " " & var2
errorCode = oShell.Run(path, style, waitTillComplete)
End Sub
My R code:
options(echo=TRUE)
args = commandArgs(trailingOnly=TRUE)
var1<-as.numeric(args[1])
var2 <- args[2]
It works if I only use var 1, but with var 2 I get the following message:
type mismatch
Does anyone know if it's possible to send an array from Excel to R (without using a csv file or a for loop)?
I have an R-script, which runs a VBS.
VB-Script should pass arguments back to R.
I created the codes, but passed argument is still NA.
R:
path <- "C:\\Users\\PD\\Desktop\\Dashboard Citi R\\test\\scripcik.vbs"
shell(shQuote(normalizePath(path)), "cscript", flag = "//nologo")
args<-commandArgs(TRUE)
myvar<-args[1]
print(myvar)
VBS:
dim myArr
Dim shell
Set shell = CreateObject("WScript.Shell")
chartpath6 = "C:\Users\PD\Desktop\Dashboard Citi R\test\bazy\" & myDate(now) & ".accdb"
chartpath5 = "C:\Users\PD\Desktop\Dashboard Citi R\test\bazy\" & myDate(now)-1 & ".accdb"
myArr = Array(chartpath6,chartpath5)
for i = 0 to 1
ReportFileStatus(myArr(i))
next
sub ReportFileStatus(filespec)
Dim fso, msg
Set fso = CreateObject("Scripting.FileSystemObject")
If (fso.FileExists(filespec)) Then
msg = filespec & " exists."
Else
msg = filespec & " doesn't exist."
End If
msgbox msg
End sub
Function myDate(dt)
dim m,y
m = right("0" & datePart("m",dt),2)
y = datePart("yyyy",dt)
myDate= y & m
End Function
Dim path
path = "Rscript C:\Users\PD\Desktop\Dashboard Citi R\test\runR.R " & msg
shell.Run(path)
If the variable you try to send is a text message, you can write it to a txt file and loop from R until value of the text file not null or empty (I nerver tried to code with R) and then use the value of the text file.
(I also tried wscript.echo "MYTEXT" and run it from command line but it poped a msgbox).
I need to copy a range from an Excel file into Outlook, then send it as an email. It needs to be embedded into the email itself. I found this code which works great, with one exception: It is centering the range in the middle of the "page" in outlook, and I need it to align to the left.
I am assuming this is done in HTML but I do not know that language. Here is the code I am using:
Option Explicit
Public Sub prcSendMail()
Dim objOutlook As Object, objMail As Object
Set objOutlook = CreateObject(Class:="Outlook.Application")
Set objMail = objOutlook.CreateItem(0)
With objMail
.To = "Mike.Marshall#worldpay.us"
.Subject = "Hallo"
.HTMLBody = fncRangeToHtml("Summary", "B2:G26")
.Display 'zum testen
' .Send
End With
Set objMail = Nothing
Set objOutlook = Nothing
End Sub
Private Function fncRangeToHtml( _
strWorksheetName As String, _
strRangeAddress As String) As String
Dim objFilesytem As Object, objTextstream As Object, objShape As Shape
Dim strFilename As String, strTempText As String
Dim blnRangeContainsShapes As Boolean
strFilename = Environ$("temp") & "\" & _
Format(Now, "dd-mm-yy_h-mm-ss") & ".htm"
ThisWorkbook.PublishObjects.Add( _
SourceType:=xlSourceRange, _
Filename:=strFilename, _
Sheet:=strWorksheetName, _
Source:=strRangeAddress, _
HtmlType:=xlHtmlStatic).Publish True
Set objFilesytem = CreateObject("Scripting.FileSystemObject")
Set objTextstream = objFilesytem.GetFile(strFilename).OpenAsTextStream(1, -2)
strTempText = objTextstream.ReadAll
objTextstream.Close
For Each objShape In Worksheets(strWorksheetName).Shapes
If Not Intersect(objShape.TopLeftCell, Worksheets( _
strWorksheetName).Range(strRangeAddress)) Is Nothing Then
blnRangeContainsShapes = True
Exit For
End If
Next
If blnRangeContainsShapes Then _
strTempText = fncConvertPictureToMail(strTempText, Worksheets(strWorksheetName))
fncRangeToHtml = strTempText
Set objTextstream = Nothing
Set objFilesytem = Nothing
Kill strFilename
End Function
Public Function fncConvertPictureToMail(strTempText As String, objWorksheet As Worksheet) As String
Const HTM_START = "<link rel=File-List href="
Const HTM_END = "/filelist.xml"
Dim strTemp As String
Dim lngPathLeft As Long
lngPathLeft = InStr(1, strTempText, HTM_START)
strTemp = Mid$(strTempText, lngPathLeft, InStr(lngPathLeft, strTempText, ">") - lngPathLeft)
strTemp = Replace(strTemp, HTM_START & Chr$(34), "")
strTemp = Replace(strTemp, HTM_END & Chr$(34), "")
strTemp = strTemp & "/"
strTempText = Replace(strTempText, strTemp, Environ$("temp") & "\" & strTemp)
fncConvertPictureToMail = strTempText
End Function
Is there some code to left align the range I am copying into Outlook?
I have W7 x64, Excel 2013 and Outlook 2013.
Thanks!
add this after your objTextstream.Close
strTempText = Replace(strTempText, "align=center x:publishsource=", "align=left x:publishsource=")
This worked for me
With objMail
.To = "Bofa#deeznutz.com"
.cc = ""
.Subject = "BR1 Summary for Adjustments +/- >$250"
.HTMLBody = "<table width='100'><tr><td align=left>" + fncRangeToHtml("weekly adjustments report", Sheet1.UsedRange.Address) + "</td></tr></table>" & "<br>" & "<b>" & "<font size=4>" & "Adjustments +/- >$250" & "</font>" & "</b>" & fncRangeToHtml("Sheet1", Sheet2.UsedRange.Address)
VBA likes the quotes and the spaces. but in that last line of code you can either quote all of you HTML functions or break it up. but once you are finished using that like bold, you have to "/function" to end it before it likes the information. the & and + work the same.
How to modify a VB script to archive event logs? I found one VB script working just fine to archive event logs to a network share folder, but I am not sure where to modify the VB script to:
Only collect system, application and security logs not all logs
How to make these archive logs with month, date and year and save them to the same folder daily and not overwrite them.
You need to change this line ("Select * from Win32_NTEventLogFile") Example
("Select * from Win32_NTEventLogFile where LogFileName='Application'")
Add in filter for the logs you wish to backup see http://social.technet.microsoft.com/Forums/scriptcenter/en-US/febbb896-e7fb-42c6-9b1b-6f3e3b293b22/event-viewer-log-script-only-working-for-application-event-log
OR
http://www.activexperts.com/activmonitor/windowsmanagement/scripts/logs/event/
This should help you.
See the following altered code for your requirements, will output required logs and save to a different folder each day.
VBS
Dim strComputer, objDir2
Dim current: current = Now
Dim strDateStamp: strDateStamp = dateStamp(current)
strComputer = "YourServer"
objDir2 = "Your File Server Path" & strDateStamp
Dim objDir1: objDir1 = "\\" & strComputer & "\c$\EVT"
clearEVTLogs = "No"
Set filesys=CreateObject("Scripting.FileSystemObject")
If Not filesys.FolderExists(objDir1) Then
createDir(objDir1)
If Not filesys.FolderExists(objDir2) Then
createDir(objDir2)
End If
strPath = objDir2 & "\"
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate, (Backup, Security)}!\\" _
& strComputer & "\root\cimv2")
Set colLogFiles = objWMIService.ExecQuery _
("Select * from Win32_NTEventLogFile where LogFileName='Application' Or LogFileName='Security' Or LogFileName='System'")
For Each objLogfile In colLogFiles
strCopyFile = strDateStamp & "_" & strComputer & "_" _
& objLogFile.LogFileName & ".evt"
strBackupFile = "c:\EVT\" & strDateStamp & "_" _
& strComputer & "_" & objLogFile.LogFileName & ".evt"
strBackupLog = objLogFile.BackupEventLog _
(strBackupFile)
Call copyAFile(objDir1, strPath, strCopyFile)
If clearEVTLogs = "Yes" Then
objLogFile.ClearEventLog()
End If
Next
Function dateStamp(ByVal dt)
Dim y, m, d
y = Year(dt)
m = Month(dt)
If Len(m) = 1 Then m = "0" & m
d = Day(dt)
If Len(d) = 1 Then d = "0" & d
dateStamp = y & m & d
End Function
Function copyAFile( Byval strSourceFolder, Byval strTargetFolder, _
Byval strFileName)
Dim objFSO, booOverWrite, strResult
Set objFSO = CreateObject( "Scripting.FileSystemObject")
If objFSO.FileExists( strSourceFolder & "\" & strFileName) _
And UCase( strSourceFolder) <> UCase( strTargetFolder) Then
If objFSO.FolderExists( strTargetFolder) Then
Else
strResult = "The destination folder does not exist!"
'copyAFile = strResult
Exit Function
End If
If objFSO.FileExists( strTargetFolder & "\" & strFileName) Then
strResult = "The file exists, overwritten"
booOverWrite = vbTrue
Else
strResult = "The file does not exist, created"
booOverWrite = vbFalse
End If
objFSO.CopyFile strSourceFolder & "\" _
& strFileName, strTargetFolder & "\", booOverWrite
Else
strResult = "The source file does not exist, or " _
& "identical Source and Target folders!"
End If
End Function
Function createDir(strDir)
Set filesys=CreateObject("Scripting.FileSystemObject")
Set objFSO = CreateObject("Scripting.FileSystemObject")
wscript.echo strDir
If Not filesys.FolderExists(strDir) Then
Set objFolder = objFSO.CreateFolder(strDir)
End If
End Function
I have a text file having three fields category name, image name and link or URL. The three fields are stored in the text file separated by comma. I want to read the textfile values and display them one by one that is in a column format. So all the category names will be displayed in one column, image name in one column and link in one column.
I have read the text file and i get all the contents in text file in a variable. The content that i get in variable is as follows:
glass,glassbowlcategory.jpg,www.google.com glass,glassbowlcategory.jpg,www.google.com glass bowl,images1.jpg,http://www.fitnessfirstusa.com/catalog.asp?Brand=LG%20Sciences
In the above string first one is category name, second is image name and third is link.
I have used the folllowing code to read text file.
Sub BuildFileList(strFolder)
Dim strFileName1
Dim strSearchText
Dim objFSO, objTextFile
Dim strReadLineText
Dim intLineNumber,strNewContents
Dim strLineNumbers
Dim objFile
' Name of text file to search:
'
'strFileName = "readme.txt"
strFileName1 = "saveimagename.txt"
Const ForReading = 1
Const ForWriting = 2
'' Create an instance of the the File System Object
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objTextFile = objFSO.OpenTextFile(Server.MapPath(strFileName1))
intLineNumber = 0
'
strLineNumbers = ""
Do While Not objTextFile.AtEndOfStream
intLineNumber = intLineNumber + 1
strReadLineText = objTextFile.ReadLine
' response.Write(strReadLineText)
strNewContents = strNewContents & strReadLineText & vbCrLf
response.Write(strNewContents)
'
Loop
end sub
Please advise how can i split the contents that i get in the variable and display them
For tabular data
Const ForReading = 1
Const ForWriting = 2
Dim objTextFile
Dim intLineNumber, strNewContents, strReadLineText
dim data, columns
strFileName1 = "saveimagename.txt"
Set objTextFile = CreateObject("Scripting.FileSystemObject").OpenTextFile(Server.MapPath(strFileName1))
intLineNumber = 0
strLineNumbers = ""
data = split(objTextFile.readall(), vbcrlf)
for intLineNumber = 0 to ubound(data)
columns = split(data(intLineNumber), ",", 3)
if (ubound(columns) = 2) then
strNewContents = strNewContents & "<tr><td>" & columns(0) & "</td><td>" & columns(1) & "</td><td>" & columns(2) & "</td></tr>" & vbcrlf
end if
next
response.write "<table>" & strNewContents & "</table>"
perhaps you could use Microsoft ActiveX Database Objects (ADO) for that?
here are some links:
Much ADO about Text Files
Microsoft ODBC Desktop Database Drivers
and some sample code:
'http://msdn.microsoft.com/en-us/library/ms974559.aspx
dim conn : set conn = server.createObject("ADODB.Connection")
dim rs : set rs = server.createObject("adodb.recordset")
dim sql
conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & _
importPath & ";" &_
"Extended Properties=""text;HDR=" & HDR & ";FMT=Delimited"""
sql = "SELECT * FROM " & myImportFile
rs.open sql, conn, adOpenStatic, adLockOptimistic, adCmdText