Hard code email address in Excel - vba

The following is a simple code that will send an email using whatever email program is open. My problem is that I would like to add three emails to the list but outlook 2013 only recognizes it if I have one address.
What is the correct format for outlook?
Application.Dialogs(xlDialogSendMail).Show _
arg1:="attributes#hotmail.ca", _
arg2:="East attributes" & Now()
I have tried
Application.Dialogs(xlDialogSendMail).Show _
arg1:="attributes#hotmail.ca" & ";" & "runaway#gmail.com", _
arg2:="East attributes" & Now()

Here is a very basic example of how to automate Outlook from Excel. Please note I am using LateBinding.
Option Explicit
Sub Sample()
Dim OutApp As Object
Dim OutMail As Object
Dim MyFileList(1) As String
Dim i As Long
'~~> Change/Add the file names here
MyFileList(0) = "C:\Sample1.xlsx"
MyFileList(1) = "C:\Sample2.xlsx"
'~~> Create a new instance of outlook
Set OutApp = CreateObject("Outlook.Application")
'~~> Create a new Email
Set OutMail = OutApp.CreateItem(0)
'~~> Set the To/CC/BCC etc here
With OutMail
.To = "MyEmail1#123.com" & ";" & "MyEmail2#123.com" & ";" & "MyEmail3#123.com"
.CC = "MyEmail4#123.com"
.Bcc = "MyEmail5#123.com"
.Subject = "Example for attaching 2 files"
.Body = "Hi Russel :)"
'~~> Attaching file
For i = LBound(MyFileList) To UBound(MyFileList)
.Attachments.Add MyFileList(i)
Next i
'~~> Display the email. To send the email, Change the below to .Send
.Display
End With
End Sub
ScreenShot:

You can automate Outlook from Excel to get the job done. See How to automate Outlook from another program for more information.
Use the Recipients collection to specify the To, CC or Bcc recipients.

Related

Insert filepath as hyperlink Excel VBA

I have a VBA set of code that generates an email and automatically sends it.
One of the things that I cannot get to work properly is putting a hyperlink to a specified folder location within the email.
Dim fpath As String
fpath = Worksheets("MS_JRNL_OPEN_TU_FR-4333635").Range("AD5").Value
"file://" & fpath & _
Essentially the user has to input a folder location when running the Macro which is in Cell AD5, but I want this is appear as the full folder location as a hyperlink once the email is generated.
Any help would be greatly appreciated
If you are currently using HTMLBody in your email code, it's quite easy to do. I'll assume you are using code similar to below. Take note of strbody and .HTMLBody. Assuming your fpath is formatted like C:\Users\tjb1\Desktop\file.docx then you don't need to add anything else to it. The section creating the hyperlink is "test link". You can change test link to say whatever you want or change the line to "" & fpath & "" to use the path as the link text.
Sub MailURL()
Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
strbody = "test link"
On Error Resume Next
With OutMail
.To = "APerson#Somewhere.com"
.Subject = "Testing URL"
.HTMLBody = strbody
.Send
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
I found the code above at MrExcel and just formatted it a bit to work with your variable.

Trying to .SaveAs an Outlook MailItem, getting Run-time error '287' Excel VBA

My department uses Access to create PDFs and sends out documents in a generic e-mail template. They currently do this by opening the template, attaching the PDF manually, and then send it off. After the e-mail is sent, they then drag the .msg file from the Outlook Sent folder into each client folder individually.
I wrote an Excel VBA to read the e-mail addresses in each cell, attach the PDF through a path, send the e-mail, and then save the .msg automatically.
The problem: The .SaveAs function will not work for me as I get runtime error 287. Everything else works (Attachments, .Display, .Send, etc.) if I leave the .SaveAs out.
Things I have done: I have the Microsoft Outlook 12.0 Objects referenced, and I have tried both early and late binding. This is on a workstation and they use Excel 2010, but when I try on my home computer with Excel 2013 (Outlook 15.0 Objects) it DOES work.
I am baffled... Also, here's a link to a screen shot of the error and the line:
Sub CreateNewMessage()
Dim OutApp As Object
Dim objOutlookMsg As Object
Dim Pth As String
Dim cell As Range
Pth = "some\path\" 'Path to PDF folder
Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application") 'Set Outlook application
On Error GoTo Cleanup
'For Loop to find each cell of e-mails
For Each cell In Columns("E").Cells.SpecialCells(xlCellTypeConstants)
'Finds e-mail values # and . for cell value
If cell.Value Like "?*#?*.?*" Then
Set objOutlookMsg = OutApp.CreateItem(0)
On Error GoTo Cleanup
With objOutlookMsg
.To = cell.Value
.Subject = Cells(cell.Row, "C").Value & " - Approval Letter"
.body = "Pre-worded e-mail template"
.Attachments.Add Pth & Dir(Pth & Cells(cell.Row, "C") & "\" & .Subject & ".msg" 'Attach PDF
'This next SaveAs line throws the error, or if I keep the error handler in, it goes to Cleanup and nothing happens
.SaveAs "Path\To\Save\Folder" & Cells(cell.Row "C") & _
"\" & .Subject & ".msg" 'Save MailItem to folder
.Display '.Send
End With
On Error GoTo 0
Set objOutlookMsg = Nothing
End If
Next cell
Cleanup:
Set OutApp = Nothing
Application.ScreenUpdating = True
End Sub
I see your code has the "," in the Cells(cell.Row, "C") so that's just a typo above,
but you haven't changed the default line to match your path (in your image either)
"Path\To\Save\Folder"

Issue with reading data from specific cells in Excel VBA

I'm attempting to send an email containing an Excel workbook from within the document using the built in VB macros. There is data in one of the sheets, which are relevant to sending the email (Subject, recipient etc). I am trying to access these using the Sheets object like so
Sub Button1_Click()
Dim OutApp As Object
Dim OutMail As Object
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
Dim cell As Object
Dim count As Integer
count = 0
For Each cell In Selection
count = count + 1
Next cell
If count <> 1 Then
MsgBox ("You must select exactly one cell, which shall be the e-mail address of the recipient")
Wscript.Quit
Else
recipient = ActiveCell.Value
End If
On Error Resume Next
With OutMail
.To = recipient
.CC = ""
.BCC = ""
.SentOnBehalfOfName = This.Sheets("MailContent").Range("A2").Value
.Subject = This.Sheets("MailContent").Range("A4").Value
.Body = This.Sheets("MailContent").Range("A6").Value & vbNewLine & This.Sheets("MailContent").Range("A7") & vbNewLine & vbNewLine & "Næste gang senest den " + This.Sheets("MailContent").Range("A10") & vbNewLine & vbNewLine & This.Sheets("MailContent").Range("A8")
.Attachments.Add ActiveWorkbook.Name
.Display
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
I've also been able to replicate the same error with this small snippet
Sub Button1_Click()
Dim subjectCell As Range
subjectCell = This.Sheets("MailContent").Range("A2")
MsgBox (subjectCell.Value)
End Sub
I've tried using WorkSheets, Sheets, ActiveWorkbook to access the cells, but I'm sure it's just a problem of how I assign the data, since I'm not used to languages with syntax like VB. Any help is much appreciated, and if you need more info leave me a comment.
You need to use the 'Set' keyword to assign to a range.
Set subjectCell = ThisWorkbook.Sheets("MailContent").Range("A2")
This still catches me out on an irritatingly regular basis.

Send an email from a group email address in outlook using VBA

I currently want to build a VBA function that enables people to send emails using a group email address(e.g. person A has an email address a#111.com and he is also a member of "student" group and has access to send emails using the groups email address student#111.com)
I am thinking about using a VBA to build such a function. It is easy to construct body, recipient and etc. but how to shift the sender i.e. from field to the group email address?
Did you want any more than just how to send it? I'm slightly confused by your question.
Sub Mail_Workbook_1()
Dim OutApp As Object
Dim OutMail As Object
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
' Change the mail address and subject in the macro before you run it. Or pass variables to it
With OutMail
.To = "tom#google.com" 'You can also set it equal to something like TextBox1.Text or any string variable or item
.CC = ""
.BCC = ""
'Once again for the next two you can pull this from a cell, a textbox, or really anything
.Subject = "This is the Subject line"
.Body = "Hello World!"
.Attachments.Add ActiveWorkbook.FullName
' You can add other files by uncommenting the following line.
'.Attachments.Add ("C:\test.txt")
' In place of the following statement, you can use ".Display" to
' display the mail.
.Send
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
Maybe you just need to edit the reply-to address so that any replies get sent to the group?
Here's how, using Outlook:
'Tools > References ... > check "Microsoft Outlook object library"
Dim outlookApp As Outlook.Application
Dim mailMsg As MailItem
Dim replyToRecipient As Recipient
Set outlookApp = CreateObject("Outlook.Application")
Set mailMsg = outlookApp.CreateItem(olMailItem)
With mailMsg
.To = "abc#111.com"
Set replyToRecipient = .ReplyRecipients.Add("group#111.com") ' group adderss
replyToRecipient.Resolve
If Not replyToRecipient.Resolved Then Err.Raise 9999, , _
replyToRecipient.Address _
& " could not be resolved as a valid e-mail address."
'...
'... edit body etc. here...
'...
.Display
End With

excel VBA to send e-mail from macro

I am writing a macro to send an e-mail from an excel sheet. The macro prepares a few reports and then has a function to prepare the e-mail for the report. Everything works fine except when it gets to the .Send line it gives me a run time error -2147467259. Not sure what this means, but would appreciate the help.
Here is the code for the function:
Function Mail_Reports(ByRef wkDate2 As String, fileDate2 As String, wkNumber2 As String, thisYear2 As String)
' Works in Excel 2000, Excel 2002, Excel 2003, Excel 2007, Excel 2010, Outlook 2000, Outlook 2002, Outlook 2003, Outlook 2007, Outlook 2010.
' This example sends the last saved version of the Activeworkbook object .
Dim OutApp As Object
Dim OutMail As Object
Dim mailList As String
Dim i As Long, lstRow As Long, p As Long, addressNum As Long, begRow As Long
Dim proNam2 As String
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
'On Error Resume Next
' Change the mail address and subject in the macro before you run it.
For i = 1 To 5 Step 1
mailList = ""
lstRow = Sheets("Data").Cells(Rows.Count, i).End(xlUp).Row
addressNum = lstRow - 16
begRow = lstRow - addressNum
proNam2 = Sheets("Data").Cells(16, i)
proNam2 = Replace(proNam2, " ", "")
For p = 1 To addressNum Step 1
mailList = Sheets("Data").Cells(begRow + p, i) & " ; " & mailList
Next p
With OutMail
.To = mailList
'.CC = "" remove comma and use this if you want to cc anyone, can be string or variable
'.BCC = "" remove comma and use this if you want to cc anyone, can be string or variable
.Subject = "Test"
.HTMLBody = "<HTML><BODY><Font Face=Calibri(Body)><p>Hi All,</p><p2>Attached to this e-mail is the test file.<p2/><br><br><p3>Best,<p3/></font></BODY></HTML>"
.attachments.Remove 1
.attachments.Add "C:\Documents and Settings\test.xlsx"
.Display
.Send
Next i
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Function
Can you please try with just,
Save the report file into a local drive
use one email address first, so remove the for loop
send it with just one file/range/workbook.
remove html tags for signature or etc..
Code:
With WB '-- workbook
.SaveAs TempFilePath & TempFileName & FileExtStr, _
FileFormat:=FileFormatNum
On Error Resume Next
With OutMail
.To = "myname#myname.com"
.CC = ""
.BCC = ""
.Subject = "This is the Subject line"
.Body = "Here is a Report on My VBA analysis"
.Attachments.Add Dest.FullName
'You can add other files also like this
'.Attachments.Add ("C:\testmail.txt") '-- .xls
.Send 'or use .Display
End With
On Error GoTo 0
.Close SaveChanges:=False
End With
Update based on the comments with OP:
Looking at your email concat loop, you do not have to do it each time when a new book comes UNLESS YOUR MAILING LIST DIFFERS FOR EACH WORKBOOK.... You may take that loop out of the mail workbooks iteration.
For p = 1 To addressNum Step 1
mailList = Sheets("Data").Cells(begRow + p, i) & " ; " & mailList
Next p
One problem I can see here is that you do the following:
Set OutMail = OutApp.CreateItem(0)
outside the send loop. You should move that here:
[...]
For p = 1 To addressNum Step 1
mailList = Sheets("Data").Cells(begRow + p, i) & " ; " & mailList
Next p
Set OutMail = OutApp.CreateItem(0)
With OutMail
[...]
I can't comment on your specific error because I don't know what data is going into your OutMail object. However, to help you debug, I recommend you:
Close the With OutMail block with an End With
Set a reference to Microsoft Outlook 14.0 Object Library
Declare OutApp as Outlook.Application (Dim OutApp as Outlook.Application)
Declare OutMail as Outlook.MailItem (Dim OutMail as Outlook.MailItem)
Initialise OutApp as follows: Set OutApp = New Outlook.Application
The above are not necessary (except maybe closing your With OutMail block) but may help you to diagnose problems with your code.
Also note that if you're using a newer version of Outlook, other applications (Excel, Word, Access etc.) may be prevented from sending by security controls: http://support.microsoft.com/kb/263084.