I have an existing form in outlook that I need to create a macro for. It is a formed used to submit data to our corporate office. Every time, I have to fill in my employee number, address, First and Last, etc... can someone help me create a macro to fill in these fields so I do not have to copy and paste or type my information every time? Thanks!
This HTML email creater. Insert this into the "Visual Basic Editor in Tools>Macro then run the
macro "emailpictures". It will ask for validation.
Sub emailpicture()
Set objOutlook = CreateObject("Outlook.Application")
Set objOutlookMsg = objOutlook.CreateItem(olMailItem)
Set objOutlookRecip = objOutlookMsg.Recipients.Add("companyemail#email.com")
objOutlookRecip.Type = olTo
objOutlookMsg.Subject = "Picture"
' add "C:\picture.png as attachment to Outlook message
Set colAttach = objOutlookMsg.Attachments
Set l_Attach = colAttach.Add("C:\path\image.jpg")
' Dereference the attachment objects before changing their properties via CDO
Set colAttach = Nothing
Set l_Attach = Nothing
'Set body format to HTML
objOutlookMsg.BodyFormat = olFormatHTML
objOutlookMsg.HTMLBody = "<HTML><head></head><BODY><center><table><tr><td><center><h1>Title </h1></center></td></tr><tr><td><center><h1>Body</h1></center><br /></td></tr><img src=""image.jpg"" alt=image><br /><br /></td></tr><tr><td><center><h3>Hope you will have a worderous day!</h3></center><br /><br /></td></tr><tr><td><center><h3>From</h3></center><br /><br /></td></tr></table></center></BODY></HTML>"
objOutlookMsg.Send
Set objOutlookRecip = Nothing
Set objOutlookMsg = Nothing
Set objOutlook = Nothing
End Sub
Sub emailfromexcel()
Dim OutApp As Object
Dim OutMail As Object
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With OutMail
.To = "person#email.com"
.BCC = thebcc
.Subject = "This subject"
.Body = "This body"
.Display
.Send
End With
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
Sub emailfromexcel()
Dim OutApp As Object
Dim OutMail As Object
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With OutMail
.To = "person#email.com"
.BCC = thebcc
.Subject = "This subject"
.Body = "This body"
.Display
.Send
End With
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
Related
I have the following code but it is not working. I am fairly new to VBA as well. The code works to populate the email template but as soon as I add the .Attachment.Add it does not work.
Sub CreateMail()
Dim objOutlook As Object
Dim objMail As Object
Dim rngTo As Range
Dim rngSubject As Range
Dim rngBody As Range
Set objOutlook = CreateObject("Outlook.Application")
Set objMail = objOutlook.CreateItem(0)
With ActiveSheet
Set rngTo = .Range("E2")
Set rngSubject = .Range("E3")
Set rngBody = .Range("E4")
.Attachments.Add "Z:\PHS 340B\Letters of Non-Compliance\..Resources\W9 Form\VPNA W-9 01 09 2017"
End With
With objMail
.to = rngTo.Value
.Subject = rngSubject.Value
.Body = rngBody.Value
.Display 'Instead of .Display, you can use .Send to send the email _
or .Save to save a copy in the drafts folder
End With
Set objOutlook = Nothing
Set objMail = Nothing
Set rngTo = Nothing
Set rngSubject = Nothing
Set rngBody = Nothing
End Sub
Try this:
Sub emailtest()
Dim objOutlook As Object
Dim objMail As Object
Dim rngTo As Range
Dim rngSubject As Range
Dim rngBody As Range
Set objOutlook = CreateObject("Outlook.Application")
Set objMail = objOutlook.CreateItem(0)
With ActiveSheet
Set rngTo = .Range("E2")
Set rngSubject = .Range("E3")
Set rngBody = .Range("E4")
End With
With objMail
.To = rngTo.Value
.Subject = rngSubject.Value
.Body = rngBody.Value
.Attachments.Add "Z:\PHS 340B\Letters of Non-Compliance\..Resources\W9 Form\VPNA W-9 01 09 2017"
.Display 'Instead of .Display, you can use .Send to send the email _
or .Save to save a copy in the drafts folder
End With
Set objOutlook = Nothing
Set objMail = Nothing
Set rngTo = Nothing
Set rngSubject = Nothing
Set rngBody = Nothing
End Sub
You need to use the .Attachments.Add when working within Outlook not Excel.
This simple script should illustrate the point of how to add attachments to an email, and then send the email.
Sub Mail_workbook_Outlook_1()
'Working in Excel 2000-2016
'This example send the last saved version of the Activeworkbook
'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm
Dim OutApp As Object
Dim OutMail As Object
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.to = "ron#debruin.nl"
.CC = ""
.BCC = ""
.Subject = "This is the Subject line"
.Body = "Hi there"
.Attachments.Add ActiveWorkbook.FullName
'You can add other files also like this
'.Attachments.Add ("C:\test.txt")
.Send 'or use .Display
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
https://www.rondebruin.nl/win/s1/outlook/amail1.htm
I am trying to achieve:
the email was sent to Outlook "Sent Items" folder therefore email is
not in the "Outbox" folder.
email did not return due to delivery failure (email will be in the
"Inbox" folder deliver by postmaster#mail.hotmail.com)
The following code is used to send an email from an Access form via Outlook:
Private Sub cmdEmail1_Click()
Dim OutApp As Outlook.Application
Dim OutMail As Outlook.MailItem
Dim strBody As String
Dim strPDF As String
Dim strFolder As String
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(olMailItem)
strBody = Me.txtSubject
strPDF = Me.txtFile
On Error Resume Next
With OutMail
.To = Me.txtemail
.CC = ""
.BCC = Me.txtBBCemail
.Subject = Me.txtSubject
.Body = Me.txtMessage
.Recipients.ResolveAll
' .SendUsingAccount = OutApp.Session.Accounts.Item(2) '2nd email
.SentOnBehalfOfName = Me.txtFromEmail
.Attachments.Add strPDF 'attachments
.Send
End With
Me.txtSent = "email was sent to Outlook "
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
Thanks a lot
Norbert
Both of these will be asynchronous and you will be able to process the notification at a later point, seconds or even minutes later.
I don't think #1 will help you much - it only tells you that the network was not disconnected. Why does it matter? Even if it is down, Outlook will send the message later.
For #2, it all depends on who sent the NDR. If it is Exchange, you will be able to figure out the bad recipient address. Otherwise you might just get a message with no good way to figure out what the problematic recipient was.
EDIT. For Items.ItemAdd, see the following (off the top of my head):
Dim OutApp As Outlook.Application
Dim WithEvents SentItems As Outlook.Items
sub SentItems_ItemAdd(Item As Object)
MsgBox Item.Subject
end sub
Private Sub cmdEmail1_Click()
Dim OutMail As Outlook.MailItem
Dim strBody As String
Dim strPDF As String
Dim strFolder As String
Dim ns As Outlook.Namespacee
if (OutApp Is Nothing) Then
Set OutApp = CreateObject("Outlook.Application")
set ns = OutApp.GetNamespace("MAPI")
ns.Logon
set SentItems = ns.GetDefaultFolder(olFolderSentMail).Items
End If
Set OutMail = OutApp.CreateItem(olMailItem)
strBody = Me.txtSubject
strPDF = Me.txtFile
On Error Resume Next
With OutMail
.To = Me.txtemail
.CC = ""
.BCC = Me.txtBBCemail
.Subject = Me.txtSubject
.Body = Me.txtMessage
.Recipients.ResolveAll
' .SendUsingAccount = OutApp.Session.Accounts.Item(2) '2nd email
.SentOnBehalfOfName = Me.txtFromEmail
.Attachments.Add strPDF 'attachments
.Send
End With
Me.txtSent = "email was sent to Outlook "
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
I have a folder test that contains the following files user1.xlsx , user2.xlsx , user3.xlsx
In my working spreadsheet work.xlsx i have corresponding addresses
user1.xlsx user1name#gmail.com
user2.xlsx user2name#yahoo.com
...
How can I send emails with the attached user1 , user2 .xlsx files to corresponding emails
'Email
Dim OutApp As Object
Dim OutMail As Object
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = userVar
.SentOnBehalfOfName = "xxxx"
.CC = ""
.BCC = ""
.Subject = "...
.Body = "...
.Attachments. .. ??
.Send
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
'Close
Have you reviewed this MS KB? It details the VBA for sending an email as below:
Sub SendMessage(DisplayMsg As Boolean, Optional AttachmentPath)
Dim objOutlook As Outlook.Application
Dim objOutlookMsg As Outlook.MailItem
Dim objOutlookRecip As Outlook.Recipient
Dim objOutlookAttach As Outlook.Attachment
' Create the Outlook session.
Set objOutlook = CreateObject("Outlook.Application")
' Create the message.
Set objOutlookMsg = objOutlook.CreateItem(olMailItem)
With objOutlookMsg
' Add the To recipient(s) to the message.
Set objOutlookRecip = .Recipients.Add("Nancy Davolio")
objOutlookRecip.Type = olTo
' Add the CC recipient(s) to the message.
Set objOutlookRecip = .Recipients.Add("Michael Suyama")
objOutlookRecip.Type = olCC
' Add the BCC recipient(s) to the message.
Set objOutlookRecip = .Recipients.Add("Andrew Fuller")
objOutlookRecip.Type = olBCC
' Set the Subject, Body, and Importance of the message.
.Subject = "This is an Automation test with Microsoft Outlook"
.Body = "This is the body of the message." &vbCrLf & vbCrLf
.Importance = olImportanceHigh 'High importance
' Add attachments to the message.
If Not IsMissing(AttachmentPath) Then
Set objOutlookAttach = .Attachments.Add(AttachmentPath)
End If
' Resolve each Recipient's name.
For Each ObjOutlookRecip In .Recipients
objOutlookRecip.Resolve
Next
' Should we display the message before sending?
If DisplayMsg Then
.Display
Else
.Save
.Send
End If
End With
Set objOutlook = Nothing
End Sub
Notice that you have to Set the objOutlookAttach using the AttachmentPath, which would be the same as the location of your file (hardcode or use current directory as path). Your loop should be for each email address in a specified range, grab the corresponding filename (from adjacent cell), append it to the AttachmentPath variable, and then used to set the objOutlookAttach.
UPDATE: a more up-to-date, related MS article can be found here for additional reference and guidance.
I am trying to send emails from a specific account but it always sends from my main no matter how much code I try or what I do. Is there any way to tell it to send it from a particular account? I am writing my code in MS Access, but using Outlook objects.
Sub testEmail()
On Error Resume Next
Set outapp = GetObject(, "Outlook.Application")
If outapp Is Nothing Then
Set outapp = CreateObject("Outlook.Application")
End If
Set oMail = outapp.CreateItem(olMailItem)
With oMail
.To = "randomaddress#randomdomain.com"
.Subject = "test2"
.Send
End With
Set outapp = Nothing
Set oMail = Nothing
End Sub
Updated code:
Option Compare Database
Sub testEmail()
On Error Resume Next
Set oApp = CreateObject("Outlook.Application")
Set oMail = oApp.CreateItem(olMailItem)
Set olAccount = oApp.Account
Set olAccountTemp = oApp.Account
Dim foundAccount As Boolean
Dim strFrom As String
strFrom = "FROMADDY#randomaddress.com"
foundAccount = False
Set olAccounts = oApp.Application.Session.Accounts
For Each olAccountTemp In olAccounts
Debug.Print olAccountTemp.smtpAddress
If (olAccountTemp.smtpAddress = strFrom) Then
Set olAccount = olAccountTemp
foundAccount = True
Exit For
End If
Next
If foundAccount Then
Debug.Print "ACCT FOUND!"
With oMail
.To = "randomaddress#random.com"
.Body = "Message!"
.Subject = "test3"
.sendusingaccount = olAccount
End With
Else
Debug.Print "No acct found"
End If
Set oApp = Nothing
Set oMail = Nothing
Set olAccounts = Nothing
Set olAccount = Nothing
Set olAccountTemp = Nothing
End Sub
Try using
Set oMail.sendusingaccount=olAccount
instead of
oMail.sendusingaccount=olAccount
It worked for me, your code is perfect, just the Set is missing.
It is also much easier when the user can select the email address rather than account number. sendCaller loops through the accounts until it finds this email address. From there on it will call sendFile from where the message will be sent.
Sub sendCaller()
'creates outlook application
'chooses an email address and finds the corresponding account number
Dim OutApp As Object
Dim i As Integer, accNo As Integer
Set OutApp = CreateObject("Outlook.Application")
emailToSendTo = "name#domain.com" 'put required email address
'if smtp address=email we want to send to, acc no we are looking for is identified
For i = 1 To OutApp.Session.Accounts.Count
'Uncomment the Debug.Print command to see all email addresses that belongs to you
'''Debug.Print "Acc name: " & OutApp.Session.Accounts.Item(i) & " Acc number: " & i & " email: " & OutApp.Session.Accounts.Item(i).smtpAddress
If OutApp.Session.Accounts.Item(i).smtpAddress = emailToSendTo Then accNo = i
Next i
sendFile accNo
End Sub
Sub sendFile(accountNo As Integer)
Dim OutApp As Object
Dim OutMail As Object
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With OutMail
.To = "recipient#domain.com"
.Subject = "Test"
.Body = "Body"
Set .SendUsingAccount = OutApp.Session.Accounts.Item(accountNo)
.Send
End With
End Sub
I have the following code that sends outlook mail. But this will not work when outlook is closed.
Sub DraftMail(emailAddr, strBody, strSub)
Dim OutApp As Object
Dim OutMail As Object
Set OutApp = GetObject(, "Outlook.Application")
If OutApp Is Nothing Then
Set OutApp = CreateObject("Outlook.Application")
End If
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = ""
.CC = ""
.BCC = emailAddr
.Subject = strSub
.HTMLBody = strBody
.Send 'or use .Display
.ReadReceiptRequested = True
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
Can anybody help me how to make it work even when the outlook is closed?
Try this code :
(Not tested)
Sub SendMail()
Dim iMsg As Object
Dim iConf As Object
Dim Flds As Variant
Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")
iConf.Load -1
Set Flds = iConf.Fields
With Flds
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "<server>"
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
.Update
End With
With iMsg
Set .Configuration = iConf
.To = "test#gmail.com"
.From = "test#gmail.com"
.Subject = "MIS Reports" & " " & Date & " " & Time
.TextBody = "Link to Currency Data :" & vbNewLine & "<" & myDest & ">"
.Send
End With
Set iMsg = Nothing
Set iConf = Nothing
End Sub
First do you have any error handling in there? For example if you call getObject and it is closed you should get an error?
So the way that most people use is to call get object and if that errors then they know outlook is closed and they create a new instance.
If you want to be very precise the error code number is 429 see for example this code here Link to previous question.
To get you started this should also work
On Error Resume Next
Set OutApp = GetObject(, "Outlook.Application")
If OutApp Is Nothing Then
Set OutApp = CreateObject("Outlook.Application")
End If
Once you have this working then you can remove the "On Error Resume Next" and catch the specific error 429 if you want, and then you know that the error is because Outlook is not running.
The easiest thing to do is construct a mailto:// url and run it through a shell command.
You must URL encode the subject and body for it to show up properly.
example (paste in Run command in Windows):
mailto://user#domain.com?subject=New%20Email&body=This%20is%20the%20message%20body.