This code sends email. In the list sometimes a new employee does not have an email address yet. How can I skip creating an email if the .To in Cells(x,2) is blank and go to the Next x?
With OutMail
.To = Cells(x, 2)
.Subject = Cells(x, 3)
'Change Body for email message here
.Body = "Dear " & EmployeeName & "," & vbNewLine & vbNewLine & _
"Attached is a copy of your check stub for this week." & vbNewLine & vbNewLine & _
"Thank you," & vbNewLine & _
"Moe Ballout"
'Check if Attachment file exists, if not, then it will skip email
If Dir(filename, vbNormal) <> "" Then
.Attachments.Add (filename)
'.Display
.SendUsingAccount = OutApp.Session.Accounts(fromaccount)
.Send
End If
End With
Next
End Sub
If Len(Cells(x, 2)) > 0 Then
'your code that creates OutMail object
End If
Related
The below code embeds the photo but doesn't display because
"The file may have been moved, renamed, or deleted. Verify that the link points to the correct file and location."
I know the file path is correct.
Sub mail()
Dim Sig As String
Set myOlApp = CreateObject("Outlook.Application")
LR400 = Columns(1).Find("*", SearchDirection:=xlPrevious).Row
sPath = Environ("appdata") & "\Microsoft\Signatures\Amir Higgs.txt"
For x = 2 To LR400
If Cells(x, 2) <> "no email" Then
emails = Cells(x, 1)
'TheBody1 = "The Parallon Workforce Team" & vbCrLf & vbCrLf & vbCrLf & _
"Amir Higgs" & vbCrLf & _
"Accounts Payable Clerk" & vbCrLf & _
"Parallon Workforce Solutions" & vbCrLf & _
"1000 Sawgrass Corporate Pkwy, 6th Floor" & vbCrLf & _
"Sunrise, FL 33323" & vbCrLf & _
"P: 954-514-1656" & vbCrLf & _
"www.parallon.com"
Set myitem = myOlApp.CreateItem(olMailItem)
With myitem
.SentOnBehalfOfName = "PARA.WFAdjustments#Parallon.com"
.To = Cells(x, 2)
.Subject = Cells(x, 3)
.Body = TheBody1
'.CC = ""
.Attachments.Add emails
.Attachments.Add "C:\Users\JoeSchmo\Pictures\WF Communications.jpg", olByValue, 0
.HTMLBody = "<BODY><IMG src=""cid:WF Communications.jpg"" width=200> </BODY>"
.display
End With
End If
Next x
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
Change your JPG file name to one word Example WF_Communications.jpg or WFCommunications.jpg
.Attachments.Add "C:\Users\JoeSchmo\Pictures\WF_Communications.jpg", olByValue, 0
.HTMLBody = "<BODY><IMG src=""cid:WF_Communications.jpg"" width=200> </BODY>"
I'm trying to generate an email from data input on to a spreadsheet, to create an offer of work. We have a list of work and assign it to someone.
At the moment with my code below, I can send one offer per email by selecting the row with the work, and pressing the command button.
However, I might be offering someone up to 4 pieces of work, and ideally I would like be able to edit this code to include all rows selected.
Does anyone have any suggestions?
Private Sub Generate_offer()
Dim strFile As String
Dim OutApp As Object
Dim objOutlookMsg As Object
Set OutApp = CreateObject("Outlook.Application")
Set objOutlookMsg = OutApp.CreateItem(0)
With objOutlookMsg
.SentOnBehalfOfName = ""
.to = ""
.Subject = ""
.HTMLBody = "<p style='font-family:arial;font-size:16'> Dear <br/><br/>
[Body of email - CUT]
& "<p style='font-family:arial;font-size:14'><b>Offer</b>: " & Cells(ActiveCell.Row, "C").Value & "<br/>" _
& "<b>Dates</b>: " & Cells(ActiveCell.Row, "L").Value & " - " & Cells(ActiveCell.Row, "M").Value & "<br/>" _
& "<b>Approx. duration</b>: " & Cells(ActiveCell.Row, "P").Value & " weeks" & "<br/>" _
& "<b>Detils</b>: xxxxx - " & Cells(ActiveCell.Row, "F").Value & "; xxxxx - " & Cells(ActiveCell.Row, "G").Value & "; xxxxx - " & Cells(ActiveCell.Row, "H").Value & "<br/><br/>" & vbNewLine _
[Body of email - CUT]
.display
End With
'objOutlookMsg.Send
Set OutApp = Nothing
End Sub
Any help much appreciated.
Notice a couple things in the example below...
(Almost) never use Select. Your code is one case where you are requiring the user to select a set of offers in order to run the macro. The Selection only appears on one line though. The rest of the code only uses the established range variable offers.
Make sure your ranges are always fully qualified. For you, this means not using Cells all by itself but setting up a range variable (offers in my example) that is fully qualified and using that as the base for all your Cells references.
It would look something like this:
Private Sub Generate_offer()
Dim strFile As String
Dim OutApp As Object
Dim objOutlookMsg As Object
Set OutApp = CreateObject("Outlook.Application")
Set objOutlookMsg = OutApp.CreateItem(0)
With objOutlookMsg
.SentOnBehalfOfName = ""
.To = ""
.Subject = ""
.HTMLbody = "<p style='font-family:arial;font-size:16'> Dear <br/><br/> "
.HTMLbody = .HTMLbody & "[Body of email - CUT]"
'--- assumes that the active selection is a set of rows,
' each row with unique offer details
Dim offers As Range
Set offers = ActiveSheet.Range.Selection
Dim i As Long
For i = 1 To offers.Rows.Count
.HTMLbody = .HTMLbody & "<p style='font-family:arial;font-size:14'><b>Offer</b>: "
.HTMLbody = .HTMLbody & offers.Cells(i, "C").Value & "<br/>"
.HTMLbody = .HTMLbody & "<b>Dates</b>: " & offers.Cells(i, "L").Value
.HTMLbody = .HTMLbody & " - " & offers.Cells(i, "M").Value & "<br/>"
.HTMLbody = .HTMLbody & "<b>Approx. duration</b>: " & offers.Cells(i, "P").Value
.HTMLbody = .HTMLbody & " weeks" & "<br/>"
.HTMLbody = .HTMLbody & "<b>Details</b>: xxxxx - " & offers.Cells(i, "F").Value
.HTMLbody = .HTMLbody & "; xxxxx - " & offers.Cells(i, "G").Value
.HTMLbody = .HTMLbody & "; xxxxx - " & offers.Cells(i, "H").Value
.HTMLbody = .HTMLbody & "<br/><br/>" & vbNewLine
Next i
.HTMLbody = .HTMLbody & [Body of email - CUT]
.display
End With
'objOutlookMsg.Send
Set OutApp = Nothing
End Sub
I'm trying to set up a macro to send an email, updating people on a due date timeline. This email should pull dates from specific cells and place them into the message body. So far I'm able to set up the email to read the way I want, but am having trouble calling the dates.
I'm super new at vba and this may not be a function that's possible, but any workarounds would be appreciated! Thanks!
Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
Dim rev_1 As Date, rev_2 As Date, final_due As Date
rev_1 = Range(I2)
rev_2 = Range(K2)
final_due = Range(M2)
strbody = "XXXXXXX" & vbNewLine & vbNewLine & _
"This is an update on your project dates:" & vbNewLine & vbNewLine & _
"Review 1 Suspense: CALL CELL I2 HERE" & vbNewLine & _
"Review 2 Suspense: CALL CELL K2 HERE" & vbNewLine & _
"Final Due Date: CALL CELL M2 HERE" & vbNewLine & vbNewLine & _
"Acoording to this timeline, you are AHEAD/ON TIME/BEHIND." & vbNewLine & vbNewLine & _
"If you have any questions, please contact XXXX." & vbNewLine & vbNewLine & _
On Error Resume Next
With OutMail
.To = ""
.CC = ""
.BCC = ""
.Subject = "Upcoming Project - Timeline Update"
.Body = strbody
.Display
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
hello you could do like this
"Review 1 Suspense: " & range("I2") & vbNewLine & _
So I'm in need of some help. I'm trying to update my company's Excel tool that they use to manage clients. I currently need help with updating the Send Email function of the tool. So employees will have a list of clients they need to send an email to, and each client will have specific information like name, client number, etc., and the employees should be able to click the "Send Email" macro button that's built in, and different emails will populate in Outlook with the specific info for each client built into the Email recipient, Title and Body.
I am currently stuck. For example, I will choose 3 clients to send an email to, click the "Send Email" button, and I will get 3 emails to populate (as I should). The first email will have all of the correct info in the right place for Client #1. However, Email #2 will have the correct Email Recipient & Email Title, but then the Email Body will have the correct info for Client #2, and below that also in the Email Body will be all of the email body info for Client #1. And same for Email #3, it will have the correct recipient and title, but the Body will have body info for Client #3, then Client #2, then Client #1.
So I know that I need to fix it through some sort of loop for the email body, but I have been working on this for so long I just can't see it anymore. I've removed any sensitive information and put in placeholders, but I think you should get the idea.
Please let me know if you have any questions.
Sub SendEMail()
Dim Email As String
Dim Subj As String
Dim Msg As String
Dim URL As String
Dim r As Integer
Dim x As Double
Dim OApp As Object
Dim OMail As Variant
Dim Signature As String
Dim strbody As String
strbody = "<html><body>"
With Sheets("Email").Select
lastrow = Cells(Rows.Count, "B").End(xlUp).Row
End With
For r = 2 To lastrow
Set OApp = CreateObject("Outlook.Application")
Set OMail = OApp.CreateItem(0)
' Get the email address
Sheets("Email").Select
Email = Cells(r, "F")
' Message subject
Sheets("Email").Select
Subj = "Renewal for " & Cells(r, "B").Text & " Contract " & Cells(r, "A").Text & " Effective " & Cells(r, "C").Text
' Message body
Sheets("Email").Select
strbody = strbody & "Dear " & Cells(r, "AR").Text & ", <br><br>" & _
"I will be working with you on " & Cells(r, "B") & ", client number " & Cells(r, "A") & ", which is effective " & Cells(r, "C") & ".<br><br>" & _
"For this year's contract, we are requesting the following information: <br>" & _
"<li>" & Cells(r, "AH") & "</li>" & "<br><br>" & _
"The application form may be downloaded from:<br>" & _
"<li>Option #1</li>: " & "" & "Link#1" & "" & "<br>" & _
"<li>Option #2</li>: " & "" & "link#2" & "" & "<br><br>" & _
"Once we receive the requested information, you will receive your contract within 5 business days. Should you have any questions, please don't hesitate to contact me at this email address or phone number <br><br>" & _
"As always, we would like to thank you for your business. <br><br>" & _
"Regards, <br>"
On Error Resume Next
Sheets("Email").Select
With OMail
.Display
.To = Email
.Subject = Subj
.HTMLBody = strbody & vbNewLine & .HTMLBody
End With
Next r
On Error GoTo 0
Set OMail = Nothing
Set OApp = Nothing
End Sub
Please take a look at this example.
In column A : Names of the people
In column B : E-mail addresses
In column C:Z : Filenames like this C:\Data\Book2.xls (don't have to be Excel files)
The Macro will loop through each row in "Sheet1" and if there is a E-mail address in column B
and file name(s) in column C:Z it will create a mail with this information and send it.
Sub Send_Files()
'Working in Excel 2000-2016
'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm
Dim OutApp As Object
Dim OutMail As Object
Dim sh As Worksheet
Dim cell As Range
Dim FileCell As Range
Dim rng As Range
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
Set sh = Sheets("Sheet1")
Set OutApp = CreateObject("Outlook.Application")
For Each cell In sh.Columns("B").Cells.SpecialCells(xlCellTypeConstants)
'Enter the path/file names in the C:Z column in each row
Set rng = sh.Cells(cell.Row, 1).Range("C1:Z1")
If cell.Value Like "?*#?*.?*" And _
Application.WorksheetFunction.CountA(rng) > 0 Then
Set OutMail = OutApp.CreateItem(0)
With OutMail
.to = cell.Value
.Subject = "Testfile"
.Body = "Hi " & cell.Offset(0, -1).Value
For Each FileCell In rng.SpecialCells(xlCellTypeConstants)
If Trim(FileCell) <> "" Then
If Dir(FileCell.Value) <> "" Then
.Attachments.Add FileCell.Value
End If
End If
Next FileCell
.Send 'Or use .Display
End With
Set OutMail = Nothing
End If
Next cell
Set OutApp = Nothing
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub
You can learn more about it from the link below.
http://www.rondebruin.nl/win/s1/outlook/amail6.htm
If you want to use this macro instead of a mail merge the problem you are having is here:
strbody = strbody & "Dear " & Cells(r, "AR").Text & ", <br><br>" & _
"I will be working with you on " & Cells(r, "B") & ", client number " & Cells(r, "A") & ", which is effective " & Cells(r, "C") & ".<br><br>" & _
"For this year's contract, we are requesting the following information: <br>" & _
"<li>" & Cells(r, "AH") & "</li>" & "<br><br>" & _
"The application form may be downloaded from:<br>" & _
"<li>Option #1</li>: " & "" & "Link#1" & "" & "<br>" & _
"<li>Option #2</li>: " & "" & "link#2" & "" & "<br><br>" & _
"Once we receive the requested information, you will receive your contract within 5 business days. Should you have any questions, please don't hesitate to contact me at this email address or phone number <br><br>" & _
"As always, we would like to thank you for your business. <br><br>" & _
"Regards, <br>"
This takes the variable strbody and adds the rest of the string to it.
Update it to:
strbody = "Dear " & Cells(r, "AR").Text & ", <br><br>" & _
"I will be working with you on " & Cells(r, "B") & ", client number " & Cells(r, "A") & ", which is effective " & Cells(r, "C") & ".<br><br>" & _
"For this year's contract, we are requesting the following information: <br>" & _
"<li>" & Cells(r, "AH") & "</li>" & "<br><br>" & _
"The application form may be downloaded from:<br>" & _
"<li>Option #1</li>: " & "" & "Link#1" & "" & "<br>" & _
"<li>Option #2</li>: " & "" & "link#2" & "" & "<br><br>" & _
"Once we receive the requested information, you will receive your contract within 5 business days. Should you have any questions, please don't hesitate to contact me at this email address or phone number <br><br>" & _
"As always, we would like to thank you for your business. <br><br>" & _
"Regards, <br>"
And it will overwrite it each time which is what I think you want.
Also you don't need to select the sheet each time (or at all really). Selecting sheets, cells, etc is generally bad coding practice that can significantly slow down your code.
I have this code which sends out an email using outlook. I have multiple email accounts in outlook and I am trying to add in a way so i can tell it which email address to send it from? Can someone please show me how i can do this?
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Column = Range("AS1").Column Then
If Target.Row > 7 And Target.Value = "Send Email" Then
Range("AU" & Target.Row).Value = Date
End If
End If
If Target.Column = Range("CD1").Column Then
If Target.Row > 7 And Target.Value = "Notify" Then
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
strbody = "Dear " & Range("AE" & ActiveCell.Row) & "," & vbNewLine & vbNewLine & _
"This is an automated email, sent to you by the purchasing department." & vbNewLine & _
"We have an update on the status of your New Supplier Request. Please see the information below." & vbNewLine & vbNewLine & _
"Supplier Name: " & Range("B" & ActiveCell.Row) & vbNewLine & _
"Supplier Reference Number: " & Range("AG" & ActiveCell.Row) & vbNewLine & _
"Supplier Status: " & Range("D" & ActiveCell.Row) & vbNewLine & vbNewLine & _
"Description:" & vbNewLine & _
"We have successfully recieved your application and we have sent out our required documents to the supplier. Once these have been returned we will contact you with a further update. If you have any queries, please contact us at Purchasing#hewden.co.uk." & vbNewLine & vbNewLine & _
"What does this mean?" & vbNewLine & _
"We ask that all New Suppliers be registered to allow us to manage a more efficient supply chain. Right now you don't need to do anything else, we will contact the supplier and gather any additional information which we need. Please keep a note of your reference number in the event you should have any enquiries." & vbNewLine & vbNewLine & _
"Kind Regards," & vbNewLine & _
"Automated Purchasing Email"
On Error Resume Next
With OutMail
.to = Range("AF" & ActiveCell.Row)
.CC = "something#something.com"
.BCC = ""
.Subject = "New Supplier Request - Update"
.Body = strbody
'You can add a file like this
'.Attachments.Add ("C:\test.txt")
.Send 'or use .Display
End With
On Error GoTo 0
End If
End If
End Sub
If you are using multiple POP3/SMTP accounts, set the MailItem.SendUsingAccount property to one of the accounts from the Namespace.Accounts collection.
If you are using Exchange, set the MailItem.SentOnBehalfOfName property - you must have an explicit permission to send on behalf of that user.
Try this
With OutMail
.SentOnBehalfOfName = "YourEmailAccount#Email.com"
.to = Range("AF" & ActiveCell.Row)
.CC = "something#something.com"
.BCC = ""
.Subject = "New Supplier Request - Update"
.Body = strbody
'You can add a file like this
'.Attachments.Add ("C:\test.txt")
.Send 'or use .Display
End With