I'm trying to put together a tool to send mass emails to a query of users from a database table. I'm using the SendObject method and it works well enough.
SendObject(ObjectType, ObjectName, OutputFormat, To, Cc, Bcc, Subject, MessageText, EditMessage, TemplateFile)
I manually modify the VBA code when I need a new message; using vbNewLine to denote line breaks in the MessageText string field.
I want to create a prompt to ask the user to type in the message, and automatically format it with line breaks when the macro runs.
The emails are newsletters several paragraphs long tailored to each recipient (e.g. John Doe = Dear John Doe, Gary Stu = Dear Gary Stu).
SendObject can be set to prompt the user with an option to edit the email before sending it but each of the modifications is unique to each individual email.
You just need to make variables to generate body of email or subject or both.
For picking up data from recordset, assuming tblContactData table with first name, last name, emailID etc.
Dim strSubject as string, strSubjectLine as string
Dim strMessageBody as string, strFirstName as string, strLastName as string, recContactData as DAO.recordset
set recContactData = CurrentDB.OpenRecordset("Select * from tblContactData")
'Loop all the contacts for email
Do Until recContactData.EOF = True
' strSubjectLine = InputBox("Enter Subject Line", "Input")
strSubjectLine = "Ref No" & recContactData.Fields("ContactID")
strSubject = "Your email , " & strSubjectLine
'strFirstName = InputBox("Enter First Name", "Input")
strFirstName = recContactData.Fields("FirstName")
'strLastName = InputBox("Enter Last Name", "Input")
strLastName = recContactData.Fields("LastName")
strMessageBody = "Hello " & strFirstName & strLastName & vbNewLine & vbCrLf & " Let me first congratulate you for registering this program"
SendObject(, "", "", recContactData.Fields("EmailID"), "", "", strSubject, strMessageBody,false, "")
recContactData.MoveNext
Loop
You create a form that has two textboxes, txtFirstName, txtLastName. Then create a button and put this code in the button click event:
Try this VBA code:
Sub btnSend_Click()
Dim message as String
'Make sure to handle the case if textboxes are empty
message = "Dear " & txtFirstName.value & " " & txtLastName.value & ", " & _
vbNewLine & "Let me be the first to congratulate you on your offer!"
DoCmd.SendObject , "", "", rs![Email], "", "", "Congratulations on your hire!", message , False, ""
End Sub
Related
I have an Excel spreadsheet with the following 5 columns:
Invoice Number, 2) Company, 3) Primary Email address, 4) Secondary Email address(es), 5) Account Number
I also have a folder that contains invoices. Each invoice has the invoice number in its file name -- i.e., Inv_123456.pdf
I want to build an excel macro that -- when I provide a list of invoice number(s) will:
Open an email -- To: <Primary Contact, Cc: <Secondary contacts, and Bcc: <me,
Put the Invoice Number in the subject, and
Go to the folder containing the invoices and attach the corresponding invoice named InvNo_*.pdf, i.e., InvNo_123456.pdf
This is repeated for each invoice number and the email is displayed for review. *Initially, I want to display the email w/attachment until I am comfortable the macro works as expected.
The path to the folder containing the pre-filled invoices is --
C:\Users\christma-2\OneDrive - OurYear2Win\Documents\Clorodet\Invoice Emails\Attachments\Invoice_*.pdf
Following is the macro I've created so far. I would like to pull the invoice with the corresponding invoice number and attach it to the email.
Sub Send_Email_to_List()
Dim OL As Object, MailSendItem As Object
Dim MsgTxt As String
Set OL = CreateObject("Outlook.Application")
For Each xCell In ActiveSheet.Range(Range("C1"), Range("C" & Rows.Count).End(xlUp))
user_email = xCell.Value
user_subject = "Subject Line for the Email"
user_msg = "Thank You For Submitting this email"
Set MailSendItem = OL.CreateItem(olMailItem)
With MailSendItem
.Subject = user_subject
.Body = user_msg
.To = user_email
.CC = " "
.Bcc = "clorodet20607#aol.com"
'I need help getting the correct attachment, putting the invoice number in the subject, and cc'ing the secondary contacts
.Attachments.Add ("C:\Users\christma-2\OneDrive - OurYear2Win\Documents\Clorodet\Invoice Emails\Attachments\W1\???.pdf")
.Display
End With
Next xCell
Set OL = Nothing
End Sub
Find the corresponding contact's email address -- To: <Primary Contact, Cc: <Secondary contacts, and Bcc: <me,
You can use the CreateRecipient method creates a Recipient object. The name of the recipient; it can be a string representing the display name, the alias, or the full SMTP email address of the recipient. So, there is no need to search for the contact.
Sub ResolveName()
Dim myNamespace As Outlook.NameSpace
Dim myRecipient As Outlook.Recipient
Dim CalendarFolder As Outlook.Folder
Set myNamespace = Application.GetNamespace("MAPI")
Set myRecipient = myNamespace.CreateRecipient("Eugene Astafiev")
myRecipient.Resolve
If myRecipient.Resolved Then
Call ShowCalendar(myNamespace, myRecipient)
End If
End Sub
Sub ShowCalendar(myNamespace, myRecipient)
Dim CalendarFolder As Folder
Set CalendarFolder = myNamespace.GetSharedDefaultFolder(myRecipient, olFolderCalendar)
CalendarFolder.Display
End Sub
You can get a Contact instance by using the following sequence of calls:
recipient.AddressEntry.GetContact()
The Outlook object model supports three main ways of customizing the message body:
The Body property returns or sets a string representing the clear-text body of the Outlook item.
The HTMLBody property of the MailItem class returns or sets a string representing the HTML body of the specified item. Setting the HTMLBody property will always update the Body property immediately. For example:
Sub CreateHTMLMail()
'Creates a new e-mail item and modifies its properties.
Dim objMail As Outlook.MailItem
'Create e-mail item
Set objMail = Application.CreateItem(olMailItem)
With objMail
'Set body format to HTML
.BodyFormat = olFormatHTML
.HTMLBody = "<HTML><BODY>Enter the message text here. </BODY></HTML>"
.Display
End With
End Sub
The Word object model can be used for dealing with message bodies. See Chapter 17: Working with Item Bodies for more information.
Note, the MailItem.BodyFormat property allows you to programmatically change the editor that is used for the body of an item.
So I'm trying to make something that takes emails from a specific folder, and saves the attachments in a specific folder. I've taken this code from a previous post and retooled it for my purposes. It runs without error, but it isn't saving the file in the specified folder, and I can't for the life of me figure it out. Can anyone see my errors?
Sub ExtractFirstUnreadEmailDetails()
Dim oOlAp As Object, oOlns As Object, oOlInb As Object
Dim oOlItm As Object, Br As Object
Dim oOlAtch As Object
Dim eSender As String, dtRecvd As String, dtSent As String
Dim sSubj As String, sMsg As String
'~~> Get Outlook instance
Set oOlAp = GetObject(, "Outlook.application")
Set oOlns = oOlAp.GetNamespace("MAPI")
Set oOlInb = oOlns.GetDefaultFolder(olFolderInbox)
Set Br = oOlInb.Folders("Brokers")
'~~> Store the relevant info in the variables
For Each oOlItm In oOlInb.Items.Restrict("[UnRead] = True")
eSender = oOlItm.SenderEmailAddress
dtRecvd = oOlItm.ReceivedTime
dtSent = oOlItm.CreationTime
sSubj = oOlItm.Subject
sMsg = oOlItm.Body
Exit For
Next
Const AttachmentPath As String = "C:\Desktop\Test"
'~~> New File Name for the attachment
Dim NewFileName As String
NewFileName = AttachmentPath & Format(Date, "DD-MM-YYYY") & "-"
'NewFileName = oOlItm.Subject & Format(Date, "DD-MM-YYYY") & "-"
'~~> Extract the attachment from the 1st unread email
For Each oOlItm In Br.Items
For Each oOlAtch In oOlItm.Attachments
Subject = "Test"
NewFileName = Subject
oOlAtch.SaveAsFile NewFileName & oOlAtch.Filename
Next
Exit For
Next
End Sub
I'd be so appreciative if anyone can point anything out. Thanks!
Picking a path at random is the road to failure.
The file should be saved in a folder named Test you created in C:\Desktop
Option Explicit
Sub ExtractFirstUnreadEmailDetails()
' Set up for Outlook
' not for other applications to use Outlook VBA code
Dim oOlInb As Folder
Dim Br As Folder
Dim oOlItm As Object
Dim oOlAtch As attachment
Dim Subject As String
'~~> Get Inbox of Outlook
Set oOlInb = Session.GetDefaultFolder(olFolderInbox)
Set Br = oOlInb.Folders("Brokers")
Const AttachmentPath As String = "C:\Desktop\Test"
'~~> New File Name for the attachment
Dim NewFileName As String
'~~> Extract the attachment from the 1st unread email
For Each oOlItm In Br.Items
For Each oOlAtch In oOlItm.Attachments
Subject = "Test"
' Note the often forgotten path separator
NewFileName = AttachmentPath & "\" & Subject & Format(Date, "DD-MM-YYYY") & "-" & oOlAtch.fileName
' C:\Desktop\Test\Test17-07-2018-fileName
Debug.Print NewFileName
oOlAtch.SaveAsFile NewFileName
Next
Exit For
Next
End Sub
The result should be a file named: Test17-07-2018-Filename in the folder C:\Desktop\Test
I'm using an MS access query in which I want to pull all the emails from the query and then populate an outlook email with all the emails, the code will run but, it does not pull in the email addresses and i cannot seem to figure out why.. here is what i have so far. My thoughts are than the query used in populating the table is not being called when trying to pull the emails
Private Sub Command30_Click()
On Error GoTo Err_Command30_Click
Dim stDocName As String
stDocName = "Department E-Mail"
DoCmd.OpenQuery stDocName, acNormal, acEdit
Dim r As Recordset
Dim Email As String
Set r = CurrentDb.OpenRecordset("SELECT[tbl dmgrphcs].Email FROM [tbl dmgrphcs]WHERE(([tbl dmgrphcs].Email) Is Not Null);")
Do While Not r.EOF
Email = Email & r(0) & ";"
r.MoveNext
Loop
r.Close
DoCmd.SendObject acSendNoObject, Null, Null, "", "", Email, "", "", True, Null
Exit_Command30_Click:
Exit Sub
Err_Command30_Click:
MsgBox Err.Description
Resume Exit_Command30_Click
End Sub
Your use of the table name is not consistent
[tbl dmgrphcs]
[tbl dmgrphcs]
[tbl dmgrphcs]
The number of spaces matters. If the query accesses only one table you don't need to prefix the columns with the table name
Set r = CurrentDb.OpenRecordset("SELECT Email FROM [tbl dmgrphcs] " & _
"WHERE Email Is Not Null")
Hint: Give your buttons meaningful names before adding event handlers. Command30 does not speak. btnPullEMails or cmdPullEMail does. The event handler will then have a better name too:
Private Sub btnPullEMails_Click()
I am have the following code for excel vba that will email a range of addresses in my sheet. Howeve, I am looking to maybe use an inputbox to determine what the range is that I would like to email. The trouble i run into is getting the input to become a value that the function mailid understands. any suggestions?
Sub EmailActiveSheetWithOutlook2()
Dim oApp, oMail As Object, _
tWB, cWB As Workbook, _
FileName, FilePath As String
Application.ScreenUpdating = False
'Set email id here, it may be a range in case you have email id on your worksheet
Sheets("Sheet1").Select
mailId = Range("b4:b5").Value
'Write your email message body here , add more lines using & vbLf _ at the end of each line
Body = "Hello, it appears you have not yet filled out the transportation contact information excel sheet. This sheet was emailed to you, please complete this and send to me saved as your firstnamelastname.xls at your earliest convience." & vbLf _
& vbLf _
& "Thanks & Regards" & vbLf _
& vbLf _
& "-Ryan " & vbLf _
'Sending email through outlook
Set oApp = CreateObject("Outlook.Application")
Set oMail = oApp.CreateItem(0)
With oMail
.To = mailid
.Subject = "Transportation Committee Notice"
.Body = Body
'.Attachments.Add tWB.FullName
.send
End With
End Sub
To replicate the effect of your current code use
mailid = Application.InputBox(Prompt:="Select Range", Type:=8)
where Type:=8 specifies a return type of Range. This returns the Value property of the selected range into mailid
Alternatively use
Dim rng as Range
Set rng = Application.InputBox(Prompt:="Select Range", Type:=8)
mailid = rng.Value
rng is then set to the selected range, and can be validated before use
Note that you should add error handling to account for, eg user Cancelling the InputBox
Do not set Application.ScreenUpdating = False before issuing InputBox as this will prevent the user interacting with the screen.
As an aside, your code uses Dim incorrectly: Dim'ing a variable without a As clause declares it as `Variant.
eg
Dim oApp, oMail As Object
actually declares oApp as a Variant, use
Dim oApp As Object, oMail As Object
I have a asp:Wizard control on a site running Framework 3.5. I acquired the settings from the web host and have entered them into the Web Configuration Utility. Here's the code behind file:
Protected Sub Wizard1_FinishButtonClick(ByVal sender As Object, ByVal e As System.Web.UI.WebControls.WizardNavigationEventArgs) Handles Wizard1.FinishButtonClick
Dim mySMTPClient As New SmtpClient()
Dim sb As New StringBuilder
Dim myMail As New MailMessage("webmaster#mydomain.com", "user#mydomain.com")
Dim myFrom As New MailAddress("webmaster#mydomain.com")
Dim myTo As New MailAddress("user#anotherdomain.com")
myMail.BodyEncoding = System.Text.Encoding.UTF8
myMail.IsBodyHtml = False
myMail.To.Add(myTo)
myMail.Subject = "Request for Information"
sb.Append("Contact Name: ")
sb.Append(txtcontactname.Text)
sb.Append("<br/>Phone Number: ")
sb.Append(txtcontactphone.Text)
sb.Append("<br/>Employer Name: ")
sb.Append(txtemployername.Text)
sb.Append("<br/>City: ")
sb.Append(txtcity.Text)
sb.Append("<br/>State: ")
sb.Append(cmbstate.Text)
sb.Append("<br/>Zip: ")
sb.Append(txtzip.Text)
sb.Append("<br/>Other Location: ")
sb.Append(txtotherloc.Text)
sb.Append("<br/>Nature of Business: ")
sb.Append(txtbusnat.Text)
sb.Append("<br/>Eligible Employees: ")
sb.Append(txteligemps.Text)
sb.Append("<br/>Average Employee Turnover Per Year: ")
sb.Append(txtempturnover.Text)
sb.Append("<br/>Broker Name: ")
sb.Append(txtbrokername.Text)
sb.Append("<br/>Broker Email: ")
sb.Append(txtbrokeremail.Text)
sb.Append("<br/>Proposed Effective Date: ")
sb.Append(txteffdate.SelectedDate)
sb.Append("<br/>Limited Benefit Medical Plans: ")
For Each item As ListItem In chkmedplans.Items
If (item.Selected) Then
sb.Append(item.Text)
sb.Append(" ")
End If
Next
sb.Append("<br/>Voluntary Products/Services: ")
For Each item As ListItem In chkvolserv.Items
If (item.Selected) Then
sb.Append(item.Text)
sb.Append(" ")
End If
Next
sb.Append("<br/>Employer Paid Products/Services: ")
For Each item As ListItem In chkempserv.Items
If (item.Selected) Then
sb.Append(item.Text)
sb.Append(" ")
End If
Next
sb.Append("<br/>Preferred Benefit Enrollment Program(s): ")
For Each item As ListItem In chkenrolprog.Items
If (item.Selected) Then
sb.Append(item.Text)
sb.Append(" ")
End If
Next
sb.Append("<br/>Comments: ")
sb.Append(txtcomments.Text)
myMail.Body = sb.ToString()
Try
mySMTPClient.Send(myMail)
Catch ex As Exception
Dim ex2 As Exception = ex
Dim errorMessage As String = String.Empty
While Not (ex2 Is Nothing)
errorMessage += ex2.ToString()
ex2 = ex2.InnerException
End While
Response.Write(errorMessage)
End Try
End Sub
End Class
The code complies with no error. When loaded onto the shared hosting account, the page loads and the code allows the user to enter information into the wizard. However, the Finish button does not fire the final step. Here's the code for the final wizard step:
<asp:WizardStep ID="WizardStep4" runat="server" StepType="Complete" Title="Complete">
Thank you for your inquiry. A member of our staff will contact you regarding your request.</asp:WizardStep>
I cannot determine what is cuasing this issue. Can someone direct me as to possible causes?
Thanks,
Sid
Have you set breakpoints within the code to see if the code to send mail is actually being reached? For example, I would suggest you set breakpoints at least at the following:
To verify the FinishButtonClick event is firing.
Dim mySMTPClient As New SmtpClient()
To verify the Sendmail code is being hit.
mySMTPClient.Send(myMail)
To see if any exception is occurring.
Dim ex2 As Exception = ex
Also, there are at least a couple of other things to look out for.
The SMTP server may not be configured or properly configured.
Even if the SMTP Server is properly configured, you want to make sure your firewall (or your ISPs) is not blocking the sending of SMTP mail.