How to create a "Do Not Reply" type email using MS Outlook?

Hi Everybody

This is my first post in the Outlook section.

I have created a program to send out a number of emails automatically using Excel VBA basically to electronically (by email using MS Outlook) convey general information/event news to family and friends on behalf of a friend - acquaintance as such. That I have done and tested. Seems to work perfectly - no problems.

What I am looking to add further is the functionality where I do not wish to receive any replies from those recipients. Hard as it might be, but believe me, this fellow does not have a computer and does not really want to have anything to do with it either and hence I am doing this for him.

Is there a way that I can send - what they call - a "Do Not Reply" email. This is not because I want to hide something or am sending something profane or indecent to the intended recipients - we, at work, also regularly, get the 'Last Night Database Update Successful' general information type emails - its just I couldn't be bothered deleting all those "Thank you" type emails from the recipients.

Any suggestions would be highly appreciated.


Thanks in advance.



Best regards



Deepak Agarwal

Good Evening.

I have a few questions first before I can properly answer this question for you. There are a few different ways to accomplish this.

01.) Are you sending it through a Microsoft Exchange Server or a Web Server such as Hotmail?

02.) If you are sending it through MsExchange, are you directly connected or does it access via Pop/Smtp services?

03.) When you say you send it "using MS Outlook", how are you generating the message:
A.) Early Binding - From the Visual Basic Environment (VBE), you go to the Tools Menu and References. From there, you find and mark the reference for Microsoft Outlook xx.0. You can then define variables of type Outlook.Application and olMailItem.
B.) Late Binding - Using the CreateObject function, you can create an Outlook.Application and olMailItem Object and assign them to a generic variable of type Object.
C.) Using SendKeys - I highly, highly, and stress again, highly discourage the use of SendKeys.


If you are willing to either post your workbook or the SendMail code, that would be great. Make sure to remove your Username and Password before you submit.

Enjoy.
Scott

Dear Demosthine

I am putting the code here for your reference.

[vba]
Sub AutoSendEmailsFromMSOutlook()
Dim fd As FileDialog
Dim olMail As MailItem
Dim fso As FileSystemObject
Set fso = New FileSystemObject
Dim olApp As Outlook.Application
Dim vrtSelectedItem As Variant, thisAttachment As Variant
Dim msg1 As String, yourResponse As String
Dim subjectText As String, bodyText As String
Dim selectedFilePathAndName As String, dataSheetName As String
Dim startCol As Long, subjectAndBodyTextCol As Long
Dim absoluteLastRow As Long, selectedItemsCount As Long
Dim arrayItemsCountStart As Long, arrayItemsCountWrkg As Long
Dim selectedItemsCountStart As Long, selectedItemsCountWrkg As Long
Dim startRow As Long, wrkgRow As Long, finalRow As Long, subjectRow As Long
Dim bodyTextStartRow As Long, bodyTextWrkgRow As Long, bodyTextFinalRow As Long
Dim selectedItemsArray() As String
Set olApp = New Outlook.Application
Set fd = Application.FileDialog(msoFileDialogFilePicker)
arrayItemsCountWrkg = arrayItemsCountStart
dataSheetName = "Data"
startRow = 2: subjectRow = 2: bodyTextStartRow = 3
startCol = 1: subjectAndBodyTextCol = 4: selectedItemsCountStart = 1
arrayItemsCountStart = 0: selectedItemsCount = 0: absoluteLastRow = 65536
subjectText = Cells(subjectRow, subjectAndBodyTextCol).Value
With fd
.AllowMultiSelect = True
.InitialView = msoFileDialogViewDetails
.InitialFileName = "C:\"
If .Show = -1 Then
For Each vrtSelectedItem In .SelectedItems
selectedItemsCount = selectedItemsCount + 1
Next vrtSelectedItem
If selectedItemsCount = 1 Then
selectedFilePathAndName = .SelectedItems(1)
Else
ReDim selectedItemsArray((selectedItemsCount - 1)) As String
Do While arrayItemsCountWrkg < selectedItemsCount
selectedItemsArray(arrayItemsCountWrkg) = .SelectedItems((arrayItemsCountWrkg + 1))
arrayItemsCountWrkg = arrayItemsCountWrkg + 1
Loop
End If
Else
msg1 = "You have not made any selection!"
msg1 = msg1 & Chr(10) & Chr(10) & "Are you sure you do not want to attach any documents to the emails you are about to send out?"
yourResponse = MsgBox(prompt:=msg1, Buttons:=vbQuestion + vbYesNo + vbDefaultButton2, Title:="Attachment Document Selection")
If yourResponse = vbYes Then
'Send with no attachments
msg1 = "Your emails will now be sent without any attachments!"
MsgBox prompt:=msg1, Buttons:=vbInformation + vbOKOnly, Title:="Information"
Else
'Terminate send with advise to rerun the program
msg1 = "Terminating program now without sending any emails out."
msg1 = msg1 & Chr(10) & Chr(10) & "Please rerun the program making appropriate selections when prompted to do so!"
MsgBox prompt:=msg1, Buttons:=vbInformation + vbOKOnly, Title:="Terminating Program"
End
End If
End If
End With
wrkgRow = startRow
bodyTextWrkgRow = bodyTextStartRow
finalRow = Worksheets(dataSheetName).Cells(startRow, startCol).End(xlDown).Row
If finalRow = absoluteLastRow Then
If Worksheets(dataSheetName).Cells(startRow, startCol).Value = "" Then
'No records
msg1 = "There are no email addresses to send emails out to!"
msg1 = msg1 & Chr(10) & Chr(10) & "Please appropriately populate the primary document with email addresses and then rerun the program!"
msg1 = msg1 & Chr(10) & Chr(10) & "Terminating Program Now!"
MsgBox prompt:=msg1, Buttons:=vbCritical + vbOKOnly, Title:="Terminating Program"
End
End If
End If
bodyTextFinalRow = Worksheets(dataSheetName).Cells(bodyTextStartRow, subjectAndBodyTextCol).End(xlDown).Row
Do While bodyTextWrkgRow <= bodyTextFinalRow
If bodyTextWrkgRow = (bodyTextFinalRow - 2) Then
bodyText = bodyText & Worksheets(dataSheetName).Cells(bodyTextWrkgRow, subjectAndBodyTextCol).Value & Chr(10) & Chr(10) & Chr(10)
ElseIf bodyTextWrkgRow = (bodyTextFinalRow - 1) Then
bodyText = bodyText & Worksheets(dataSheetName).Cells(bodyTextWrkgRow, subjectAndBodyTextCol).Value & Chr(10) & Chr(10) & Chr(10) & Chr(10)
ElseIf bodyTextWrkgRow = bodyTextFinalRow Then
bodyText = bodyText & Worksheets(dataSheetName).Cells(bodyTextWrkgRow, subjectAndBodyTextCol).Value
Else
bodyText = bodyText & Worksheets(dataSheetName).Cells(bodyTextWrkgRow, subjectAndBodyTextCol).Value & Chr(10) & Chr(10)
End If
bodyTextWrkgRow = bodyTextWrkgRow + 1
Loop
Do While wrkgRow <= finalRow
Set olMail = olApp.CreateItem(olMailItem)
With olMail
.To = Cells(wrkgRow, startCol).Value
.Subject = subjectText
.Body = bodyText
If selectedItemsCount = 1 Then
thisAttachment = selectedFilePathAndName
.Attachments.Add thisAttachment
Else
selectedItemsCountWrkg = selectedItemsCountStart
arrayItemsCountWrkg = arrayItemsCountStart
Do While selectedItemsCountWrkg <= selectedItemsCount
thisAttachment = selectedItemsArray(arrayItemsCountWrkg)
.Attachments.Add thisAttachment
selectedItemsCountWrkg = selectedItemsCountWrkg + 1
arrayItemsCountWrkg = arrayItemsCountWrkg + 1
Loop
End If
.Send
End With
Set olMail = Nothing
wrkgRow = wrkgRow + 1
Loop
Set olApp = Nothing
Set fd = Nothing
Set fso = Nothing
End Sub
[/vba]
I am definitely doing through Early Binding and sending it through Pop/SMTP services.

However, just for my information, how does it make a difference if it were through a web server such as Hotmail or if I were directly connected to the MS Exchange server?

Hope this answers some of your questions!


Best regards


Deepak Agarwal

Good Morning Deepak.

There is quite a big difference between sending via a Web Service such as Hotmail and using an MsExchange Server or SMTP Server. It is much more difficult, though not impossible, to access Web Services via code. Web Servers also do not permit Address Resolution, which takes a literal name such as ?Jolly Roger? and resolves it to an actual email address using it?s User Directory. Utilizing a MsExchange Server or SMTP Server, though, makes things much easier. There are numerous different options for sending mail via SMTP: MsOutlook, ADO (Access Data Objects), CDO (Collaborative Data Objects), and API calls?

Unfortunately, due to the way MsOutlook is set up, especially with the release of Office 2003, a lot of the more advanced features are disabled for ?Security Reasons.? Because of this, I highly recommend using Collaborative Data Objects, or CDO. This will change the some parts of the process and result in more preliminary work in making the connection.

Between my partner and I, we manage to run all three of the most recent versions of MsOffice. His laptop has Office 2000, our office has Office 2003, and my home systems have Office 2007. Because of this, we have found it very difficult to work with late binding for our references. When we would switch between versions, we almost always ended up with invalid references to Microsoft Outlook xx.0. Although the programming is more difficult initially, especially during the learning phase, ultimately, it saves you time and effort in the event of an upgrade.

That being said, the attached example is written using late bindings. In our project, we were writing an Excel program that we only wanted to open if the file name matched the exact reference in our code and the file was only located in a specific location. If these criteria were not met, an email would be sent to us stating the Accept Use Policy had been violated. To ensure that the messages always were successfully sent, we could not rely on using Microsoft Outlook.


The attached example does not include attachments. That was not a requirement of our project. But you already have a pretty good understanding of the overall SMTP system, so it should be fairly easy for you to add that it. If you need additional help, feel free to respond or to PM me.\

Scott
[vba]
Option Explicit
'//*************************************************************************** **********//
'// Author: Mark Stump //
'// Date: orig: 2007 //
'// NOTES: //
'// The ability to send mail automatically has resulted in Microsoft adding //
'// additional restrictions to what a programmer is permitted access to in //
'// Microsoft Outlook. Although this may seem to complicate the process for //
'// legitimate users, there is always a workaround. The solution is Collaborative //
'// Data Objects (CDO). //
'// //
'// In the attached example, the SMPT Server, Username and Password have been //
'// removed for security purpose. In order for the example to work, you must //
'// substitute your access information. //
'// //
'// *************************************************************************** *********//

Public strCurUserSMTP
Public strUserEmailPassword
Function CDOMail_SendMessage(SendTo As String, SendCC As String, SendBCC As String, _
From As String, ReplyTo As String, _
Subject As String, BodyHTML As String, BodyPlain As String)
' Declare the constants required to properly set the Configuration Fields
' for accessing the SMTP Server.
Const conSendUsing = 2
Const conSmtpServerPort = 25
Const conSmtpAuthenticate = 1
' Declare the variables to properly set the Configuration Fields and
' compose the Message. Because we are using Late Binding, these are
' abstract data types.
Dim objMessage As Object
Dim objConfiguration As Object
Dim varFields As Variant
' Create new instances for the Configuration and Message.
Set objConfiguration = CreateObject("CDO.Configuration")
Set objMessage = CreateObject("CDO.Message")
' Load the CDO Source Defaults.
objConfiguration.Load -1

' Set the Configuration Fields for accessing the SMTP Server.
Set varFields = objConfiguration.Fields
With varFields
.Item("h*t*t*p://schemas.microsoft.com/cdo/configuration/sendusing") = _
conSendUsing
' You may not use variables or constants while defining the SMTP Server. It
' must be a literal string.
.Item("h*t*t*p://schemas.microsoft.com/cdo/configuration/smtpserver") = _
""
.Item("h*t*t*p://schemas.microsoft.com/cdo/configuration/smtpserverport") = _
conSmtpServerPort
.Item("h*t*t*p://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = _
conSmtpAuthenticate
' You may not use variables or constants while defining the UserName. It
' must be a literal string.
.Item("h*t*t*p://schemas.microsoft.com/cdo/configuration/sendusername") =
""
' You may not use variables or constants while defining the Password. It
' must be a literal string.
.Item("h*t*t*p://schemas.microsoft.com/cdo/configuration/sendpassword") = _
""
.Update
End With
' Generate the Message using the arguments passed to the function and send the
' message.
With objMessage
Set .Configuration = objConfiguration
.To = SendTo
.CC = SendCC
.BCC = SendBCC
.From = From
' This is the key to the "Do Not Reply" process you have requested. By
specifying an address in the ReplyTo property, you can have the reply go
to a dead email address, often just "DoNotReply@Domain.Com."
.ReplyTo = ReplyTo
.Subject = Subject
' If the argument for HTML was not empty, we define the HTML Body for the
' message. This will override any text in the TextBody property of the
' message if the user is capable of viewing HTML Messages.
If BodyHTML <> "" Then _
.HTMLBody = BodyHTML
' If the argument for Plain Text was not empty, we define the Text Body for
' the message.
If BodyPlain <> "" Then _
.TextBody = BodyPlain
.Send
End With
' Process Garbage Collection to restore memory.
Set objMessage = Nothing
Set objConfiguration = Nothing
Application.EnableEvents = False
End Function
[/vba]