Link to home
Start Free TrialLog in
Avatar of TazDevil1674
TazDevil1674Flag for United Kingdom of Great Britain and Northern Ireland

asked on

VBS to send email via Outlook 2010

I use multiple Exchange Accounts in Outlook 2010, I have created a VB Script to extract data from a CSV file and create emails to 20-50 users monthly.

I have this working fine but been unable to get the VBScript to select the correct Exchange Account - its not the default one which I use constantly.

Is there a way to select the correct Exchange account as the 'SendUsingAccount'?

'Mailer script that extracts information from CSV file to

'const
	const ForReading = 1
	const Separator = ","

'init
	Set fso = CreateObject("Scripting.FileSystemObject")
	Set objOutlook = CreateObject("Outlook.Application")
	

	strDataFile = "C:\Users\emailtest.csv"	'this is name and location of txt file with data
	
	intCounter = 0
	

'Read data to create mail msg

	Set objFile = fso.OpenTextFile (strDataFile, ForReading)
	
	Do
	  '1- Read records from textfile
		strTextLine = objFile.ReadLine
		arrItem= Split(strTextLine, Separator)

		'waste some memory, for clarity
		strSurname = arrItem(3)
		strFirstName = arrItem(4)	
		strEmail = arrItem(5)
		strStatus = arrItem(9)
		strDate = arrItem(10)	

		If strStatus = "Expired" Then
		  strStatusMsg = "expired"
		  strStatusDate = "at your earliest convenience"
		ElseIf strStatus = "Valid" Then
		  strStatusMsg = "expires"
		  strStatusDate = "by this date"
		Else
		  strStatusMsg = "ERRORm"
		  strStatusDate = "ERRORd"
		End If

		If strEmail = "Email" Then
			strEmail = "own@email.com"
		ElseIf strEmail = "-" Then
			strEmail = "own@email.com"
		End If
		
	  '2- Create email message

		strMsgBody = vbCrLf & _
				strFirstName & " " & strSurname & vbCrLf & _
				vbCrLf & _
				"Your qualification " & strStatusMsg & " on " & strDate & 	"." & vbCrLf & _
				vbCrLf &_
				"ipsom lorum " & strStatusDate & " " & _
				vbCrLf				
				
		' debug : msgbox to see if it works so far
		'MsgBox strEmail & vbCrLf & vbCrLf & strMsgBody, vbOKonly, strTitle

		If objOutlook = "Outlook" Then
			'Set objMailMsg = objOutlook.CreateItem(0)
			Set objMailMsg = objOutlook.CreateItem(olMailItem)
				With objMailMsg
					'.SentOnBehalfOfName = "own@email.com" 
					.To = strEmail 
					.Subject =  "Qualification " & strStatusMsg & " on " & strDate
					.Body =  strMsgBody
					'.HTMLBody =  strMsgBody
					'.BodyFormat = olFormatHTML
					'.Importance = olImportanceNormal
					'.DeleteAfterSubmit = True		'don't keep sent mail
				End With
			If objMailMsg.To <> "" Then
				SMTPAddress = "own@email.com"
				With objMailMsg
					.SendUsingAccount = SMTPAddress
					.Send
				End With
			end if				
			intCounter = intCounter + 1
		End If
		Set objMailMsg = Nothing
 
	Loop While objFile.AtEndOfStream = False
	
	'cleanup
	objFile.Close
	Set objFile = Nothing
	Set fso = Nothing
	
'	objOutlook.Quit
	Set objOutlook = Nothing

	strFeedback="Script completed" & vbCrLf & _ 
			intCounter & " messages placed in Outlook OutBox"
	MsgBox strFeedback, vbOKonly, StrTitle

	Wscript.Quit

Open in new window


I have 3 different Exchange accounts configured in Outlook plus iCloud and own ISP email using POP3.  I need to use one of the Exchange accounts...

Many thanks in advance
ASKER CERTIFIED SOLUTION
Avatar of TazDevil1674
TazDevil1674
Flag of United Kingdom of Great Britain and Northern Ireland image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial