I need to adjust my macro described below that it runs on mac with using Apple Mail application.
Sub SendMail()
Dim OutlookApp As Object: Set OutlookApp = CreateObject("Outlook.Application")
Dim var As Variant: var = Selection.Value
Set MyMail = OutlookApp.CreateItem(0)
With MyMail
.To = var(1, 8)
.Subject = "Skuska"
.body = "Dobry den...bla bla bla" & vbNewLine & vbNewLine & var(1, 2) & vbNewLine & var(1, 3) & vbNewLine & var(1, 5) & " " & var(1, 4) & vbNewLine & vbNewLine & "Tel.c.:" & vbNewLine & var(1, 6) & vbNewLine & var(1, 7) & vbNewLine & vbNewLine & var(1, 9) & vbNewLine & vbNewLine & "S pozdravom" & vbNewLine & "Meno" & vbNewLine & "Tel."
.sent
End With
End Sub
This macro run with Outlook but I´m using Apple Mail.
Outlook for Mac 2011 (nor Apple Mail) does not support VBA. As far as I know automation of Outlook for Mac or Apple Mail can be accomplished using Applescript and/or Automator. See Introduction to Scripting Mail for more information.
Related
I have about 35 files that I run daily, all of which send their own email to a different distribution list, depending on which report is being sent, and all from a shared email account which has been added to my Outlook. I have 2 files that, for some odd reason, will not send from the shared email account I need to use.
**Edit: To clarify, the code runs to completion, and I can see the email open and disappear quickly, as if the email DID send. But nothing sends and no email shows in that account's sent items.
I have added the Microsoft Outlook 16.0 Object Library in my references, and all files are essentially using the same code:
Public Sub sendEmail()
Dim OutLookApp As Object, oAccount As Outlook.Account
Dim OutLookMailItem As Object
Set OutLookApp = CreateObject("Outlook.application")
Set OutLookMailItem = OutLookApp.CreateItem(0)
For i = 1 To Outlook.Application.Session.Accounts.Count
Set oAccount = OutLookApp.Session.Accounts.Item(i)
If oAccount = "notmypersonalaccount#xxx.com" Then Exit For
Next
With OutLookMailItem
Set .SendUsingAccount = OutLookApp.Session.Accounts.Item(i)
.To = "user1; user2; user3; user4; user5; " _
& "user6; user7; user8; user9; user10; user11; " _
& "user12; user13; user14; user15; user16; " _
& "user17; user18; user19; user20; user21; user22"
.CC = "user23; user24; user25"
.BCC = ""
.Subject = "Queue Inquiry for " & Format(Now, "m/d/yyyy") & ":"
.Display
.HTMLBody = "<BODY style=font-size:11pt;font-family:Cambria>Good Morning, " & "<br>" & "<br>" & _
"Please follow the link below to view the Queue Inquiry Report for " & Format(Now, "m/d/yyyy") _
& ". Below are the queue listings applicable for each area. This report will show you the volume in each queue and is sorted by oldest referral date (to help manage SLAs/Production)." _
& "<br>" & "<br>" & "Fraud Queues" & "<br>" & "- JPF" & "<br>" & "- PFR" & "<br>" & "<br>" _
& "C/S Back Office" & "<br>" & "- LBX" & "<br>" & "- SCK" & "<br>" & "- WSN" & "<br>" & "- TCR" & "<br>" & "- FIC" & "<br>" & "<br>" _
& "Dispute Resolution" & "<br>" & "- CS1" & "<br>" & "- APP" & "<br>" & "- RDP" & "<br>" & "- RTV" & "<br>" & "<br>" _
& "Credit Bureau Disputes" & "<br>" & "- CBD" & "<br>" & "<br>" _
& "Credit Back Office" & "<br>" & "- LTQ" & "<br>" & "<br>" _
& "Collections" & "<br>" & "- MGR" & "<br>" & "<br>" _
& "Bankruptcy" & "<br>" & "- LD7" & "<br>" & "- MM4" & "<br>" & "<br>" _
& "xxxxx xxxxx</BODY>" & .HTMLBody
.Send
End With
End Sub
What I don't get is that this file was working yesterday, before I added 6 new people to the distro list, user17 through user22. If I comment out the .SendUsingAccount = OutLookApp.Session.Accounts.Item(i) I am able to send using my email account.
Any thoughts?
Some changes that may make the code more reliable.
Option Explicit
Public Sub sendEmail()
Dim OutLookApp As Object
Dim oAccount As Outlook.account
Dim OutLookMailItem As Object
Dim srchAccount As String
Dim i As Long
Dim foundFlag As Boolean
Set OutLookApp = CreateObject("Outlook.application")
Set OutLookMailItem = OutLookApp.CreateItem(0)
srchAccount = "notmypersonalaccount#xxx.com"
For i = 1 To Session.Accounts.Count
Set oAccount = Session.Accounts.Item(i)
Debug.Print oAccount
If oAccount = srchAccount Then
foundFlag = True
Exit For
End If
Next
If foundFlag = True Then
With OutLookMailItem
Set .SendUsingAccount = oAccount
' without a subsequent .Send you can see the mail
.Display
End With
Else
MsgBox srchAccount & " not found."
End If
End Sub
To remove Excel from possible causes.
Option Explicit
Public Sub sendEmail_NotFromExcel()
Dim oAccount As account
Dim OutLookMailItem As Object
Dim srchAccount As String
Dim i As Long
Dim foundFlag As Boolean
Set OutLookMailItem = CreateItem(olMailItem)
srchAccount = "notmypersonalaccount#xxx.com"
For i = 1 To Session.Accounts.count
Set oAccount = Session.Accounts.Item(i)
Debug.Print oAccount
If oAccount = srchAccount Then
foundFlag = True
Exit For
End If
Next
If foundFlag = True Then
With OutLookMailItem
Set .SendUsingAccount = oAccount
.Display
End With
Else
MsgBox srchAccount & " not found."
End If
End Sub
I'm trying to automate creation of an email with a user required to press Send so it can be checked. I can get the mail item created with a 'To' list and such, however when I try to add an attachment I get an error.
Sub EmailReportX(ByVal MailTo As String, AttachFilename As String, AttachFilePath As String, SubjectDate As String)
Dim objOutlook As Object
Dim objMailItem As Object
Dim strAtt As String
Set objOutlook = CreateObject("Outlook.Application")
Set objMailItem = objOutlook.CreateItem(olMailItem)
strAtt = AttachFilePath & AttachFilename
With objMailItem
.To = MailTo
.Subject = "Seymour Horst Daily Completions Report " & SubjectDate
.body = "Morning," & vbCrLf & vbCrLf & "Daily completions report for review" & vbCrLf & vbCrLf & "Regards" & vbCrLf & vbCrLf & "Tim C"
.Attachments.Add = strAtt
.display
End With
Debug.Print strAtt
End Sub
.Attachments.Add() is a method and thus does not require the equals sign.
https://learn.microsoft.com/en-us/office/vba/api/outlook.attachments.add
so use it like this.
With objMailItem
.To = MailTo
.Subject = "Seymour Horst Daily Completions Report " & SubjectDate
.body = "Morning," & vbCrLf & vbCrLf & "Daily completions report for review" & vbCrLf & vbCrLf & "Regards" & vbCrLf & vbCrLf & "Tim C"
.Attachments.Add strAtt
.display
End With
I'm looking to make an automated email script using vba to read from an Excel spreadsheet; the email address and dates (that sort of thing) then place them into the correct fields to send
It would be preferable if it could also finish the line of the spreadsheet and start a new one with a new email
I can currently make an email with vba but that's about it and manually dictate the fields within the script but that's about it. Any help on how to input cell data automatically would be much appreciated.
Thanks :)
Edit 1:
Option Explicit
Sub Send_email()
Dim Line As Long
Dim OutlookApp As Outlook.Application
Dim OutlookMail As Outlook.MailItem
Set OutlookApp = New Outlook.Application
For Line = 2 To 3
Set OutlookMail = OutlookApp.CreateItem(olMailItem)
With OutlookMail
.To = Range("A" & Line).Value
.CC = ""
.BCC = ""
.Subject = "OVERDUE DOCUMENTATION - " & Range("C" & Line).Value & " " & Range("B" & Line).Value & " - " & Range("D" & Line).Value
.BodyFormat = olFormatHTML
.Display
.HTMLBody = "Dear " & Range("F" & Line).Value & "," & "<br>" & "<br>" & "The documentation for " & Range("C" & Line).Value & " " & Range("B" & Line).Value & "'s appointment with Dr " & Range("E" & Line).Value & " on " & Range("D" & Line).Value & " is now overdue." & "<br>" & "<br>" & "Please send through the documentation immediately or the doctor may cancel this appointment due to insufficient time too view the documents prior to the appointment." & "<br>" & "<br>" & "<br>" & "Regards," & "<br>" & "<br>" & "Documents Team" & .HTMLBody
End With
Next Line
End Sub
This seems to be the solve in case anyone has the same issue.
Thanks
The below code is more specific when defining the cells, which worked during my testing.
Option Explicit
Sub Send_email()
Dim Line As Long
Dim OutlookApp As Outlook.Application
Dim OutlookMail As Outlook.MailItem
Set OutlookApp = New Outlook.Application
Dim wb As Workbook: Set wb = ThisWorkbook
Dim ws As Worksheet: Set ws = wb.Worksheets("Sheet1")
For Line = 2 To 3
Set OutlookMail = OutlookApp.CreateItem(olMailItem)
With OutlookMail
.To = ws.Range("A" & Line).Value
.CC = ""
.BCC = ""
.Subject = "OVERDUE DOCUMENTATION - " & ws.Range("C" & Line).Value & " " & ws.Range("B" & Line).Value & " - " & ws.Range("D" & Line).Value
.BodyFormat = olFormatHTML
.Display
.HTMLBody = "Dear " & ws.Range("F" & Line).Value & "," & "<br>" & "<br>" & "The documentation for " & ws.Range("C" & Line).Value & " " & ws.Range("B" & Line).Value & "'s appointment with Dr " & ws.Range("E" & Line).Value & " on " & ws.Range("D" & Line).Value & " is now overdue." & "<br>" & "<br>" & "Please send through the documentation immediately or the doctor may cancel this appointment due to insufficient time too view the documents prior to the appointment." & "<br>" & "<br>" & "<br>" & "Regards," & "<br>" & "<br>" & "Documents Team" & .HTMLBody
End With
Next Line
End Sub
I'm trying to generate an email from data input on to a spreadsheet, to create an offer of work. But when I do, I keep getting the same error: Compile error, user-defined type not defined
I've gone into "Tools" > References and ticked the "Microsoft Outlook 16.0 Object Library" checkbox, but I get the same error. When I'm trying to search for other answers on this subject, this seems to be the solution for most.
Option Explicit
Private Sub Generate_offer()
Dim strFile As String
Dim OutApp As Outlook.Application
Dim objOutlookMsg As Outlook.MailItem
Set OutApp = CreateObject("Outlook.Application")
Set objOutlookMsg = OutApp.CreateItem(olMailItem)
With objOutlookMsg
.SentOnBehalfOfName = ""
.To = ""
.Subject = "xxxxxxxx"
.Body = "Dear " & vbNewLine & vbNewLine & "xxxxxxxx" & vbNewLine & vbNewLine _
& "xxxxxxxx" & vbNewLine _
& "xxxxxxxx" & Cells(ActiveCell.Row, "C").Value & vbNewLine _
& "xxxxxxxx" & Cells(ActiveCell.Row, "J").Value & " - " & Cells(ActiveCell.Row, "K").Value & vbNewLine _
& "xxxxxxxx" & Cells(ActiveCell.Row, "M").Value & "xxxxxxxx" & vbNewLine _
& "Notes: " & vbNewLine & vbNewLine _
& "xxxxxxxx" & vbNewLine & vbNewLine _
& "xxxxxxxx" & vbNewLine & vbNewLine & "xxxxxxxx"
.display
End With
'objOutlookMsg.Send
Set OutApp = Nothing
End Sub
Any help much appreciated.
Your code is using 'Early Binding'.. where in order to use Dim Something As Outlook.Something, Excel needs to have the Outlook Library referenced.
You have two options.
You can rectify this by either
Adding the reference -
In the VB Editor window, ensuring the code execution is halted entirely, go to Tools > References and tick Microsoft Outlook x.x Object Library (x.x will depend on the version you have installed).
Or use late binding - which keeps the declarations open (as objects) that get bound as you use them:
Option Explicit
Private Sub Generate_offer()
Dim strFile As String
Dim OutApp As Object
Dim objOutlookMsg As Object
Dim olMailItem As Long
olMailItem = 0 ' (0 = Mail item, 1 = Appointment, 2 = Contact etc..)
Set OutApp = CreateObject("Outlook.Application")
Set objOutlookMsg = OutApp.CreateItem(olMailItem)
With objOutlookMsg
.SentOnBehalfOfName = ""
.To = ""
.Subject = "xxxxxxxx"
.Body = "Dear " & vbNewLine & vbNewLine & "xxxxxxxx" & vbNewLine & vbNewLine _
& "xxxxxxxx" & vbNewLine _
& "xxxxxxxx" & Cells(ActiveCell.Row, "C").Value & vbNewLine _
& "xxxxxxxx" & Cells(ActiveCell.Row, "J").Value & " - " & Cells(ActiveCell.Row, "K").Value & vbNewLine _
& "xxxxxxxx" & Cells(ActiveCell.Row, "M").Value & "xxxxxxxx" & vbNewLine _
& "Notes: " & vbNewLine & vbNewLine _
& "xxxxxxxx" & vbNewLine & vbNewLine _
& "xxxxxxxx" & vbNewLine & vbNewLine & "xxxxxxxx"
.display
End With
'objOutlookMsg.Send
Set OutApp = Nothing
End Sub
Note - the main reason I'd use Late Binding would be if the macro is going to be used on multiple machines with different Excel versions installed. If Early Binding is used and the reference is pointing at a specific version that isn't installed, you'll get an error. Late Binding will find any version that provides Outlook.
I get no errors when changing your Dim to Objects
Option Explicit
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 = "xxxxxxxx"
.Body = "Dear " & vbNewLine & vbNewLine & "xxxxxxxx" & vbNewLine & vbNewLine _
& "xxxxxxxx" & vbNewLine _
& "xxxxxxxx" & Cells(ActiveCell.Row, "C").Value & vbNewLine _
& "xxxxxxxx" & Cells(ActiveCell.Row, "J").Value & " - " & Cells(ActiveCell.Row, "K").Value & vbNewLine _
& "xxxxxxxx" & Cells(ActiveCell.Row, "M").Value & "xxxxxxxx" & vbNewLine _
& "Notes: " & vbNewLine & vbNewLine _
& "xxxxxxxx" & vbNewLine & vbNewLine _
& "xxxxxxxx" & vbNewLine & vbNewLine & "xxxxxxxx"
.display
End With
'objOutlookMsg.Send
Set OutApp = Nothing
End Sub
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