I'm a new VBA user and am trying to accomplish what I've described in the title using the code below.
I think it has something to do with creating dims specifically for cc/bcc/and to, but I'm not quite sure. in one column is a list of emails that have been filtered for based on specific conditions and in the column right next to it is either "" "cc" or "bcc". If it's blank, then it goes into "to" if it's cc" it goes into the .CC field etc. etc.
Sub SendList()
'DIM
Dim olApp As Outlook.Application
Dim olMail As MailItem
Dim CurrFile As String
Dim emailRng As Range, cl As Range
Dim sTo As String
'SET
Set emailRng = ActiveSheet.Range("E3:E100").SpecialCells(xlCellTypeVisible)
For Each cl In emailRng
sTo = sTo & ";" & cl.Value
Next
sTo = Mid(sTo, 2)
Set olApp = New Outlook.Application
Set olMail = olApp.CreateItem(olMailItem)
'UPDATE WORKBOOK BEFORE SENDING
ActiveWorkbook.Save
CurrFile = ActiveWorkbook.Path & "\" & ActiveWorkbook.Name
'Need to find a way to automate to TO CC and BCC
With olMail
.To = sTo
.CC = ""
.BCC = ""
.Subject = "Audit Report XYZ" & " " & "-" & " " & Date
.Body = .Body & "Test" & vbCrLf & "Test2" & vbCrLf & "Test3"
.Attachments.Add "C:\Users\uq050e\Downloads\anyfile.xlsx" 'An audit report
.Display '.Send
End With
Set olMail = Nothing
Set olApp = Nothing
End Sub
It looks like the problem is not with Outlook VBA, but with reading the Excel's content. I'd suggest learning VBA and Excel a bit first, see Getting Started with VBA in Excel 2010.
You can use the Text property of the Range class to get the text for the specified object/cell.
Related
I am trying to create an email and populate multiple recipients based off a listbox.
I tried putting the list box column reference in the ".To" line but it gives a null error.
I found code that should loop through the listbox values but it is not populating any recipients.
Public Sub cmdEmailContact_Click()
Dim appOutLook As Outlook.Application
Dim MailOutLook As Outlook.MailItem
Dim strPath As String
Dim strFilter As String
Dim strFile As String
Dim strFileEnd As String
Dim strEmailRecipients As String
strPath = "C:\Users\username\Desktop\Invoice Test\GCX"
strFilter = Me.txtInvNum
strFileEnd = ".pdf"
strFile = Dir(strPath & strFilter & strFileEnd)
strEmailRecipients = ""
For N = 0 To Me.lstContacts.ListCount - 1
If Me.lstContacts.Selected(N) = True Then
strEmailRecipients = strEmailRecipients & "; " & Me.lstContacts.Column(3, N)
End If
Next N
strEmailRecipients = Mid(strEmailRecipients, 3)
If strFile <> "" Then
Set appOutLook = CreateObject("Outlook.Application")
Set MailOutLook = appOutLook.CreateItem(olMailItem)
With MailOutLook
.BodyFormat = olFormatRichText
.To = strEmailRecipients
''.cc = ""
''.bcc = ""
.Subject = "text here"
.SentOnBehalfOfName = "emailname"
.HTMLBody = "text here"
.Attachments.Add (strPath & strFilter & strFileEnd)
'.Send
.Display
End With
Else
MsgBox "No file matching " & strPath & strFilter & strFileEnd & " found." & vbCrLf & _
"Process has been stopped."
Exit Sub
End If
End Sub
I expect strEmailRecipients to equal a semi-colon separated list of email addresses based off the listbox. There are no error messages.
Rather than building a semi-colon delimited string to populate the To property of the MailItem object, you may instead want to modify the contents of the Recipients collection when adding recipients (independent of the recipient type) to a MailItem object.
Adding an item to the Recipients collection using the Add method will yield a Recipient object, which has a Type property which may be used to designate the recipient as either to, cc, or bcc by setting the property to olTo, olCC, or olBCC (or 1, 2, or 3 if using late binding).
Hence the construction of the email might become something along the lines of the following:
Dim idx
With MailOutLook
With .Recipients
For Each idx In lstContacts.ItemsSelected
With .Add(lstContacts.ItemData(idx))
.Type = olTo
End With
Next idx
End With
.BodyFormat = olFormatRichText
' ... etc.
End With
I convert a worksheet into a PDF and am trying to have that PDF emailed to me and copied to another person. All of this will be assigned to an action button/trigger.
Option Explicit
Sub SendExcelFileAsPDF()
Dim OutlookApp As Outlook.Application
Dim emItem As Object
Dim Receipt As String, Subject As String
Dim Message As String, Fname As String
Dim Recipient As Outlook.Recipient
Recipient = "xxxxx.xxxxx#fedex.com"
Subject = "Weekly Critical Items" & " " & Range("L1")
Message = Range("D2") & Range("J2") & "Weekly Critical Items submitted" &
Range("L1") & " " & "in PDF Format"
Message = Message & vbNewLine & vbNewLine & "Offload Ops"
Fname = Application.DefaultFilePath & "/" & ActiveWorkbook.Name & ".pdf"
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Fname
Set OutlookApp = New Outlook.Application
Set emItem = OutlookApp.CreateItem(olMailItem)
With emItem
.To = Recipient = "xxxxx.xxxxx#fedex.com"
.Subject = Subject
.Body = Message
.Attachements.Add Fname
.Send
End With
Set OutlookApp = Nothing
End Sub
The recipient line is where I am having issues. When I run the debugger, it's giving
Run-Time error '91: Object variable or with block variable not set
I would dim recipient as string and update the .to assignment:
Change
Dim Recipient As Outlook.Recipient
.To = Recipient = "dennis.aikens#fedex.com"
to
Dim Recipient As string
.To = Recipient
This line
.To = Recipient = "dennis.aikens#fedex.com"
Should be just
.To = Recipient
I have an Excel Document in a Template. Users input information and Save As a new genericized number. They then hit a button that auto populates an email to one of 5 people using Vlookup and based on the cost margin.
The file is Save As'd but the e-mail recipient cannot open the file, it reads invalid location. I can close and reopen the new renamed sheet and drag it into an e-mail. I need to link to the newly saved file's name that appears in the email.
Sub Email_created_Workbook()
Dim OutApp As Object
Dim OutMail As Object
Dim Mess As Object, Recip
Recip = [Sheet1!B28].Value & "; " & [Sheet1!B27].Value
Dim strbody As String
If ActiveWorkbook.Path <> "" Then
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
strbody = "<font size=""3"" face=""Calibri"">" & _
"Hello,<br><br>" & _
"There is a New PO awaiting your approval :<br><B>" & _
ActiveWorkbook.Name & "</B> is created.<br>" & _
"Click on this link to open the file : " & _
"<A HREF=""file://" & ActiveWorkbook.FullName & _
""">Link to Workbook</A>" & _
"<br><br>Regards," & _
"<br><br>Automated Approval System</font>"
On Error Resume Next
With OutMail
.To = Recip
.CC = ""
.BCC = ""
.Subject = ActiveWorkbook.Name
.HTMLBody = strbody
.Display 'or use .Send
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
Else
MsgBox "The ActiveWorkbook does not have a path, Save the file first."
End If
End Sub
The file name does adapt in my e-mail, from PO Template, but will not open.
I believe this will help you with your current issue (closing and reopening your file before sending). I've removed the the two lines of your code where you set the Outlook objects to Nothing. To reopen the current file you can use the OnTime function like so:
Sub Email_created_Workbook()
Dim OutApp As Object
Dim OutMail As Object
Dim Mess As Object, Recip
Recip = [Sheet1!B28].Value & "; " & [Sheet1!B27].Value
Dim strbody As String
If ActiveWorkbook.Path <> "" Then
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
strbody = "<font size=""3"" face=""Calibri"">" & _
"Hello,<br><br>" & _
"There is a New PO awaiting your approval :<br><B>" & _
ActiveWorkbook.Name & "</B> is created.<br>" & _
"Click on this link to open the file : " & _
"<A HREF=""file://" & ActiveWorkbook.FullName & _
""">Link to Workbook</A>" & _
"<br><br>Regards," & _
"<br><br>Automated Approval System</font>"
On Error Resume Next
With OutMail
.To = Recip
.CC = ""
.BCC = ""
.Subject = ActiveWorkbook.Name
.HTMLBody = strbody
.Display 'or use .Send
End With
Application.OnTime Now + TimeValue("00:00:10"), "SendEmail"
ThisWorkbook.Close True 'True= yes, save changes
Else
MsgBox "The ActiveWorkbook does not have a path, Save the file first."
End If
End Sub
Sub SendEmail()
Dim OutApp As Object: Set OutApp = GetObject(, "Outlook.Application") 'Grab current instance of Outlook since we already opened the instance prior to restarting Excel
Dim oInspector As OutApp.Inspector: Set oInspector = OutApp.ActiveInspector
Dim NewMail As OutApp.MailItem: Set NewMail = oInspector.CurrentItem 'Grab currently open New/Compose Mail window
NewMail.Send 'Send Email
End Sub
Let me know if this helps resolve your issue.
This question already has answers here:
Sending emails to multiple recipients using VBA
(2 answers)
Closed 6 years ago.
I am very new to VBA. I have an already developed an Excel worksheet wherein I have an additional task as followed:
I need to create an email button and by clicking on that button, the entire worksheet should be mailed to the given recipients, also allowing me to add an attachment.
Hello Aakash Sehgal,
Sendmail()
Dim OutApp As Object
Dim OutMail As Object
Dim cell As Range
Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")
On Error GoTo cleanup
For Each cell In Columns("B").Cells.SpecialCells(xlCellTypeConstants)
If cell.Value Like "?*#?*.?*" And _
LCase(Cells(cell.Row, "C").Value) = "yes" Then
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = cell.Value
.Subject = "Aakash Sehgal"
.Body = "Dear " & Cells(cell.Row, "A").Value _
& vbNewLine & vbNewLine & _
"Please contact us to discuss bringing " & _
"your account up to date"
'You can add files also by use:
'.Attachments.Add ("C:\test.txt")
.Send 'Or use Display
End With
On Error GoTo 0
Set OutMail = Nothing
End If
Next cell
cleanup:
Set OutApp = Nothing
Application.ScreenUpdating = True
End Sub
Make a list of following columns in ActiveSheet:
In column A : Names of the people
In column B : E-mail addresses
In column C : yes or no ( if the value is yes it will create a mail)
the macro loop through each row on the Activesheet and if there is a E-mail-address in column B and "yes" in column C it will create a mail with a reminder like the one below for each person. If you have duplicate addresses in the column check out this example.
this is one example how you can make it but if you instead want to add manually the smtp is that possible too take a look here:
Sub SMTP_Mail_SEND()
Dim iMsg As Object
Dim iConf As Object
Dim strbody As String
' Dim Flds As Variant
Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")
' iConf.Load -1 ' CDO Source Defaults
' Set Flds = iConf.Fields
' With Flds
' .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
' .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") _
' = "Fill in your SMTP server here"
' .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
' .Update
' End With
strbody = "Hi there" & vbNewLine & vbNewLine & _
"This is line 1" & vbNewLine & _
"This is line 2" & vbNewLine & _
"This is line 3" & vbNewLine & _
"This is line 4"
With iMsg
Set .Configuration = iConf
.To = "test#test.com"
.CC = ""
.BCC = ""
.From = """daniel"" <daniel#test.com>"
.Subject = "This is a mail generated by use manually smtp mail"
.TextBody = strbody
.Send
End With
End Sub
Source:
http://www.rondebruin.nl/win/s1/cdo.htm
Cheers
XsiSec
I've a loop to send about 75 emails, each with an individual attachment for each individual recipient. This works, but I'm wondering how to create all these, and send them all in one go, instead of feeding them through one at a time.
I know I can use .display instead of .send to have the email show in Outlook, but is there any way to use VBA to temporarily disable sending emails, and then enable it once all mails are created?
My code looks something like this -
Dim employee_name As Variant
Dim file_path As String
Dim file_ext As String
Dim AGENT_FILE As String
Dim e As Variant
Dim email As Variant
Dim a As Integer
a = "0"
Sheets("EMAILS").Select
employee_name = Range("A1:A76").Value
file_path = "H:\Email TEST\"
file_ext = ".xlsx"
Dim OutApp As Object
Dim OutMail As Object
Dim distributionList As String
Set OutApp = CreateObject("Outlook.Application")
For Each e In employee_name
If e <> "" Then
Set OutMail = OutApp.CreateItem(0)
With Sheets("EMAILS").Select
a = a + 1
email = Range("B" & a).Value
AGENT_FILE = file_path & e & file_ext
On Error Resume Next
With OutMail
.To = email
.CC = ""
.BCC = ""
.Subject = "Daily Stats"
.Body = "Hello ," & vbCrLf & _
vbCrLf & _
"Attached are your daily stats." & vbCrLf & _
vbCrLf & _
"Regards, " & vbCrLf & _
"Oliver Lockett"
.Attachments.Add AGENT_FILE
.send
End With
End With
Set OutMail = Nothing
End If
Next
Set OutApp = Nothing
I had similar kind of stuff years ago...
I preferred using .save instead of .send. Because of this all emails where saved under drafts....once all Emails are saved....I had a macro in Outlook to send all drafts...
This can be acheived here
http://www.techrepublic.com/forum/questions/101-309127/send-all-mails-from-my-drafts-folder-at-one-go-in-outlook-2003
Why would you want to do that? Send is asynchronous, it will not block your code.