macro to create vbs and pass variable

[clintster62]

The variable to pass is EMailVar
Q: need to know how to setup vbs to receive variable

Option Explicit
' create a vbs script to receive a variable parameter and send email.
'run vbs script by passing variable
'wait for process to complete
'kill script

Sub writeVBScript()
Dim s As String
Dim SFilename As String
Dim intFileNum As Integer
Dim wshShell As Object
Dim proc As Object
Dim EMailVar As String
Dim ProcName As String
Dim VBScriptName As String

VBScriptName = "\EMailVBScript.vbs"

'write VBScript (Writes to Excel Sheet1!A1 & Calls Function Module1.ReturnVBScript)
s = ""
s = s & "Set olApp = CreateObject(""WScript.Shell"")" & vbCrLf
s = s & "olApp.Run ""outlook.exe /recycle"", 1, False" & vbCrLf
s = s & "Set CIApp = CreateObject(""Outlook.Application"")" & vbCrLf
s = s & "Set CIMessage = CIApp.CreateItem(0)" & vbCrLf
s = s & "dim EMailVar"
s = s & "With CIMessage" & vbCrLf
s = s & " .To = " & EMailVar & vbCrLf
s = s & " .Subject = ""Email test "" " & vbCrLf
s = s & " .HTMLBody = ""Message Body goes here "" " & vbCrLf
s = s & "End With" & vbCrLf
s = s & "CIMessage.Send" & vbCrLf
Debug.Print s

' Write VBScript file to disk
SFilename = ActiveWorkbook.Path & VBScriptName
intFileNum = FreeFile
Open SFilename For Output As intFileNum
Print #intFileNum, s
Close intFileNum
DoEvents

'run VBScript file and pass one variable
EMailVar = "Test_Address@gmail.com"
ProcName = "cscript " & SFilename & " " & EMailVar
Set proc = wshShell.Exec(ProcName) 'run VBScript passing variables

'Wait for script to end
Do While proc.Status = 0
DoEvents
Loop

Kill ActiveWorkbook.Path & VBScriptName
End Sub

Thanks in advance for all assistance.

 

[John_w]

In the VBScript file, use CScript.Arguments(0) to get the first argument:

s = s & "EMailVar = CScript.Arguments(0)" & vbCrLf

PS - I've added the vbCrLf

 

[clintster62]

Still can't get it to work. Here is the create script. I have tried multiple combinations.

'write VBScript (Writes to Excel Sheet1!A1 & Calls Function Module1.ReturnVBScript)
s = ""
s = s & "Set olApp = CreateObject(""WScript.Shell"")" & vbCrLf
s = s & "olApp.Run ""outlook.exe /recycle"", 1, False" & vbCrLf
s = s & "Set CIApp = CreateObject(""Outlook.Application"")" & vbCrLf
s = s & "Set CIMessage = CIApp.CreateItem(0)" & vbCrLf
s = s & "dim EMailVar" & vbCrLf
s = s & "EMailVar = CScript.Arguments(0)" & vbCrLf
s = s & "With CIMessage" & vbCrLf
s = s & " .To = EMailVar" & vbCrLf
s = s & " .Subject = ""Excel Macro - Email test "" " & vbCrLf
s = s & " .HTMLBody = ""Message Body goes here "" " & vbCrLf
s = s & "End With" & vbCrLf
s = s & "CIMessage.Send" & vbCrLf
Debug.Print


the initiate command

' Write VBScript file to disk
SFilename = ActiveWorkbook.Path & VBScriptName
intFileNum = FreeFile
Open SFilename For Output As intFileNum
Print #intFileNum, s
Close intFileNum
DoEvents

'run VBScript file and pass one variable
EMailAddVar = "panhandlewhips@gmail.com"
ProcName = "cscript " & SFilename & " " & EMailAddVar
'MsgBox ProcName
Set wshShell = CreateObject("Wscript.Shell")
Set proc = wshShell.exec(ProcName) 'run VBScript passing variables

VBS look like this prior to kill command

Set olApp = CreateObject("WScript.Shell")
olApp.Run "outlook.exe /recycle", 1, False
Set CIApp = CreateObject("Outlook.Application")
Set CIMessage = CIApp.CreateItem(0)
dim EMailAddVar
EMailAddVar = CScript.Arguments(0)
With CIMessage
.To = EMailAddVar
.Subject = "Excel Macro - Email test "
.HTMLBody = "Message Body goes here "
End With
CIMessage.Send

 

[clintster62]

Works best to generate email from macro

Option Explicit
Sub SendEmail_Example1()

Dim i As Integer
Dim EMailAdd As String
Dim Maxrow As Integer

Maxrow = 1
'email addresses are in column 1
'loop through column 1 to determine the last row = MaxRow
Do While True
If Cells(Maxrow, 1) = "" Then
Exit Do
Else
Maxrow = Maxrow + 1
End If
Loop
Maxrow = Maxrow - 1

For i = 2 To Maxrow
Dim EmailApp As Outlook.Application
Dim Source As String
Set EmailApp = New Outlook.Application
Dim EmailItem As Outlook.MailItem
Set EmailItem = EmailApp.CreateItem(olMailItem)
EMailAdd = Cells(i, 1)
EmailItem.To = EMailAdd
If InStr(1, EMailAdd, "@") > 0 Then
'EmailItem.CC = "validemail@gmail.com"
'EmailItem.BCC = "validemail@aol.com"
EmailItem.subject = "Test Email From Excel VBA"
EmailItem.HTMLBody = "Hi," & vbNewLine & vbNewLine & "This is my first email from Excel" & _
vbCrLf & vbNewLine & _
"Regards," & vbCrLf & _
"VBA Coder: " & i
'Source = ThisWorkbook.FullName
'EmailItem.Attachments.Add Source
EmailItem.Send
End If
Next
End Sub