I would like to know how to Open an Excel attachment in my inbox Outlook 2010 with VBA code.
I would like the code to:
Check for a specific subject that does not change "Test"
Check if that email is read or unread and if it is unread to use that one
I have a rule in place where the emails are stored in a subfolder based on the subject but I can change it to go back to the main inbox
I would really appreciate if you can explain what the code is doing as I am not familiar with the Outlook connection bit.
This is what I have pulled together from various sites including stackoverflow it does the job.
It seems to run for emails that have RE: in the subject for the 10PM and 5PM emails. I explicitly named subject of the two emails. Can anyone help me?
I am not familiar with declaring variables for Outlook objects. Have I declared the variables correctly?
I would also like to copy the data within each file and paste it into another workbook. I would like the data to be pasted underneath the first data from each work book so it will need to find the last row and paste it 1 row below the last row for each data on each workbook onto the open workbook which is stored in another path.
.
Sub DownloadAttachmentFirstUnreadEmail()
Const olFolderInbox = 6
Const AttachmentPath As String = "C:\My Documents\Outlook Test\"
Dim oOlAtch As Object
Set objOutlook = CreateObject("Outlook.Application")
Set objNamespace = objOutlook.GetNamespace("MAPI")
Set objFolder = objNamespace.GetDefaultFolder(olFolderInbox)
Set objFolder = objFolder.Folders("**CLIENT ISSUES**").Folders("*Daily Reports").Folders("1. Open Trade Report")
Set colItems = objFolder.Items
Set colFilteredItems1 = colItems.Restrict("[Unread] = True AND [Subject] = '10PM FXC Email notification for Martin Currie'")
Set colFilteredItems2 = colItems.Restrict("[Unread] = True AND [Subject] = 'FXC Email notification for Martin Currie Funds'")
'~~> Check if there are any actual unread 10PM FXC emails
If colFilteredItems1.Count = 0 Then
MsgBox "NO Unread 10PM Email In Inbox"
Else
'~~> Extract the attachment from the 1st unread email
For Each colItems In colFilteredItems1
'~~> Check if the email actually has an attachment
If colItems.Attachments.Count <> 0 Then
For Each oOlAtch In colItems.Attachments
'~~> save the attachment and open them
oOlAtch.SaveAsFile AttachmentPath & oOlAtch.Filename
Set wb = Workbooks.Open(Filename:=AttachmentPath & oOlAtch.Filename)
Next oOlAtch
Else
MsgBox "10PM email doesn't have an attachment"
End If
Next colItems
End If
'~~> Check if there are any actual unread FXC Email emails
If colFilteredItems2.Count = 0 Then
MsgBox "NO Unread 5PM Email In Inbox"
Else
'~~> Extract the attachment from the 1st unread email
For Each colItems In colFilteredItems2
'~~> Check if the email actually has an attachment
If colItems.Attachments.Count <> 0 Then
For Each oOlAtch In colItems.Attachments
'~~> save the attachment and open them
oOlAtch.SaveAsFile AttachmentPath & oOlAtch.Filename
Set wb = Workbooks.Open(Filename:=AttachmentPath & oOlAtch.Filename)
Next oOlAtch
Else
MsgBox "5PM email doesn't have an attachment"
End If
Next colItems
End If
End Sub
First of all, I'd suggest starting from the Getting Started with VBA in Outlook 2010 article in MSDN.
You can assign a VBA macro to the Outlook rule, it should look like the following one:
public sub test(mail as MailItem)
'
end sub
where you can check out the mail object. It looks like you need to check out the Subject, UnRead and Attachments properties of the MailItem class.
Related
In this code an Excel file table from active sheet is sent directly via email.
I need to change it to same result only difference is I need it open in Outlook as draft and not send it (there will be added more of text etc.).
I tried .Display but it won't open Outlook new email, it is displayed in Excel.
Sub Send()
Dim AWorksheet As Worksheet
Dim Sendrng As Range
Dim rng As Range
On Error GoTo StopMacro
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
'Fill in the Worksheet/range you want to mail
'Note: if you use one cell it will send the whole worksheet
Set Sendrng = Range("B1:M44")
'Remember the activesheet
Set AWorksheet = ActiveSheet
With Sendrng
' Select the worksheet with the range you want to send
.Parent.Select
'Remember the ActiveCell on that worksheet
Set rng = ActiveCell
'Select the range you want to mail
.Select
' Create the mail and send it
ActiveWorkbook.EnvelopeVisible = True
With .Parent.MailEnvelope
' Set the optional introduction field thats adds
' some header text to the email body.
.Introduction = "Dear All," & vbNewLine & vbNewLine & "Please find XXX."
With .Item
.To = "XXXX"
.Subject = "XXX"
.Send
End With
End With
'select the original ActiveCell
rng.Select
End With
'Activate the sheet that was active before you run the macro
AWorksheet.Select
StopMacro:
With Application
Replace .Send with .Display. If you want to wait for the user to either click on the Send button or dismiss the message, use .Display(true) to show it modally.
You can automate Outlook directly from an Excel macro where you could display a new mail item to a user. For example, the following code creates a new mail items, set up properties on the item and then display it for a user:
variables declared as a specific object type ie. specific to the application which is being automated:
Dim applOL As Outlook.Application
Dim miOL As Outlook.MailItem
'Create a new instance of the Outlook application. Set the Application object as follows:
Set applOL = New Outlook.Application
'create mail item:
Set miOL = applOL.CreateItem(olMailItem)
With miOL
.To = "info#test.com"
.CC = ""
.Importance = olImportanceLow
.Subject = "Mail Automation"
.Body = "Sending the Active Excel Workbook as attachment!"
'add host workbook as an attachment to the mail:
.Attachments.Add ActiveWorkbook.FullName
.ReadReceiptRequested = True
.Display
End With
'clear the object variables:
Set applOL = Nothing
Set miOL = Nothing
Don't forget to add an Outlook COM reference to your VBA project in Excel. See Automating Outlook from a Visual Basic Application for more information.
I am trying to attach a PDF from a shared drive to many Outlook emails generated by a VBA code in Excel.
One sheet has all of the email addresses that will have an email created.
The other sheet in the same workbook has inputs such as the subject line, email body text, and PDF location that can be changed based on what the mass email is about.
While the code to make the subject and htmlbody of the email works, the attachment code doesn't work.
Copying the PDF address to a cell in the active worksheet with the lines of email data, I can attach the PDF.
It is when I treat it as an input on the Inputs worksheet that the issue occurs.
Sub Email_New_Patent_Case()
Dim i As Integer
Dim AttorneyCount As Long
'Set the end of the range equal to the last row of attorney data in the sheet
AttorneyCount = WorksheetFunction.CountA(Range("B2:B10"))
For i = 1 To AttorneyCount
If ActiveSheet.Cells(i + 1, 16) > 0 Then
Dim objOutlook As Object
Set objOutlook = CreateObject("Outlook.Application")
Dim objEmail As Object
Set objEmail = objOutlook.CreateItem(olMailItem)
With objEmail
.To = ActiveSheet.Cells(i + 1, 10).Value
.CC = ""
'Make sure this cell corresponds with the Subject Line
.Subject = ActiveWorkbook.Worksheets("Inputs").Range("D3")
'Make sure nickname has nickname or first name as value
.HTMLBody = ActiveSheet.Cells(i + 1, 4).Value & ",<br><br>"
'Make sure this cell corresponds with the Body
.HTMLBody = .HTMLBody & ActiveWorkbook.Worksheets("Inputs").Range("D4")
'Make sure this cell corresponds with
' the desired attachment location on the shared drive
.Attachments.Add ActiveWorkbook.Worksheets("Inputs").Range("D5")
.Save
End With
End If
Next i
End Sub
I get an error message:
"Object doesn't support this property or method."
This is a bit ambiguous:
.Attachments.Add ActiveWorkbook.Worksheets("Inputs").Range("D5")
...because Attachments.Add can take either a string representing the full file path or an actual object. In this case Add is unable to tell whether you're trying to add the cell itself, or its Value - seems like it defaults to trying to add the range object instead of reading the cell's default property (Value)
Being more explicit fixes the problem:
.Attachments.Add ActiveWorkbook.Worksheets("Inputs").Range("D5").Value
I am trying to attach a PDF from a shared drive to many Outlook emails
and
.Attachments.Add ActiveWorkbook.Worksheets("Inputs").Range("D5") 'Make sure this cell corresponds with the desired attachment location on the shared drive
The source of the attachment can be a file (represented by the full file system path with a file name) or an Outlook item that constitutes the attachment.
So, you need to copy files on the hard drive first and then attach them passing a local file path.
I am a computer technician, not a programmer, but in my new job I have been asked to finish a macros in excel (vba).
It consists of a list of id card numbers in one of the columns (the number of cells is variable each time it is used, one day you can put 20 people and another 12 for example), and emails in another column.
In a folder there are some pdf documents whose name is the id card of the person that appears in the excel.
What they ask me is that, being ordered the id card in alphabetical order, take the id card and email. The id card will serve to find your corresponding pdf and add it as an attachment with the idea of sending it by email, to whom? there the cell is used with the email data. This has to be done with each of the existing rows, take pdf file to attach it and send email to the address of that same row until there are no more rows on the sheet.
Can someone tell me how to do that or tell me the functions I need?
Thank you.
Graphical idea:
The macro is currently set to .Display the email and not send. After you have finished running tests you will want to change this to .Send to actually send the email.
You will also need to update the value of strLocation. Inside the quotes is where you will need to put the location of the folder that houses all of your target PDFs.
The order of your cells doesn't matter here as long as each row is associated to one individual.
Hopefully these emails are internal - you should not use this for external mailing lists as you cannot offer the option to unsubscribe. Outlook may flag/ban your account if you are suspected of spam.
This assumes the values in Column C are actual email addresses that will be recognized as is by Outlook. (urdearboy#email.com)
Sub CorpCard()
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("C").Cells.SpecialCells(xlCellTypeConstants)
If cell.Value Like "?*#?*.?*" Then
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.SentOnBehalfOfName = "[your associated Outlook email here]"
.to = cell.Value
.Subject = "Subject goes here"
.Body = "Hi " & Range("B" & cell.Row).Value & "," _
'Body to be patsed here
strLocation = "C:\Users\urdearboy\Desktop\File Name\" & Cells(cell.Row, "D").Value & ".pdf"
.Attachments.Add (strLocation)
.Display
'.Send
End With
On Error GoTo 0
Set OutMail = Nothing
End If
Next cell
cleanup:
Set OutApp = Nothing
Application.ScreenUpdating = True
End Sub
Updated per suggestions from Jeeped:
I am looking for a method of creating a set of emails fitting the following parameters:
each email will be personalized to the recipient and based off a template letter set by my supervisor.
There will be a greeting line with their name and title, along with the names of the departments they oversee.
each email will have a set of documents specific to that recipient.
they should be saved to file for final inspection before they are sent.
column 5 that is not referenced in the code below is the column containing the department name.
The closest I have come is the following code:
Sub send_template_w/attachments()
On Error Resume Next
Dim o As Outlook.Application
Set o = New Outlook.Application
Dim omail As Outlook.Mailitem
Set omail =.Createitem(olMailitem)
Dim I As Long
For i=2 To Range(“a100”).End(xlUp).Row
With omail
.Body = “Dear “ & Cells(i,1).Value
.To = Cells(i,2).Value
.CC = Cells(i,3).Value
.Subject = Cells(i,4).Values
.Attachments.Add Cells(i,6)
.Attachments.Add Cells(i,7)
.SaveAs Environ("HOMEPATH") &; "\My Documents\" & Cells(i,2).Value
End With
Next
End Sub
So far, this code will generate and save an email but what I want to do is use a present email template for these emails--either by adding the greeting at the beginning and department name into the body of the the email to be sent out. Can this be done through a word or Outlook document and if so, how?
Create a model of the mail. "Save As" to an .oft file. For example MyTemplate.oft
Instead of
Set omail =.Createitem(olMailitem)
there is
Set omail = o.CreateItemFromTemplate("C:\MyTemplate.oft").
To add the entries from the Excel sheet you could include unique placeholders in the body of the template then Replace with Excel values.
I have some macros and Task Scheduler to launch Excel at a specified time, update some tables, create PDF documents from those tables and then email those PDF documents to select individuals.
Sometimes the email gets stuck in the Outbox and does not send until I open up Outlook.
Here is the code for sending the email:
Option Explicit
Public strFileName As String
Sub EmailPDFAsAttachment()
'This macro grabs the file path and stores as a concatenation/variable. Then it emails the file to whomever you specify.
' 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 FilePath As String
'This part is setting the strings and objects to be files to grab with their associated filepath. (e.g. FilePath is setting itself equal to the text where we plan to set up each report)
FilePath = "\\"ServerNameHere"\UserFolders\_AutoRep\DA\PDFs\SealantsVS1SurfaceRestore\" _
& strFileName & ".pdf"
With Application
.EnableEvents = True
.ScreenUpdating = True
' End With
'Below is where it creats the actual email and opens up outlook.
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
' ******Make sure to set the .To to only recipients that are required to view it. Separate email addresses with a semicolon (;).
' Current distribution list:
'
With OutMail
.To = "example#Example.com"
.CC = ""
.BCC = ""
.Subject = strFileName
.HTMLBody = "Hello all!" & "<br>" & _
"Here is this month's report for the Sealants vs Surface Restore. It goes as granular as to by show results by provider." & "<br>" & _
"Let me know what you think or any comments or questions you have!" & "<br>" & _
vbNewLine & .HTMLBody
'Here it attached the file, saves the email as a draft, and then sends the file if everything checks out.
.Attachments.Add FilePath
.Send
End With
On Error GoTo 0
' With Application
' .EnableEvents = True
' .ScreenUpdating = True
End With
'This closes out the Outlook application.
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
After this completes, the Private sub jumps back to the macros in this workbook and quits MS Excel with the CloseWorkbook Application.
My tools reference library in Outlook's VBA settings:
My Trust Settings:
Macro Settings:
"Enable all macros" selected
"Apply macro security settings to installed add-ins" selected
The idea is to have this program run in the early morning and have these emails in the inbox of select individuals by the time they come in to work.
If anyone is still looking for an answer; this allows to actually send an email without opening outlook app.
Dim mySyncObjects As Outlook.SyncObjects
Dim syc As Outlook.SyncObject
Set mySyncObjects = Outlook.Application.GetNamespace("MAPI").SyncObjects
Set syc = mySyncObjects(1)
syc.start
Outlook, just like any other Office app, cannot run in a service(such as the Scheduler).
That being said, you need to force Outlook to perform SendReceive and wait for it to complete. Call Namespace.SendAndReceive or retrieve the first SyncObject object from the Namespace.SyncObjects collection, call SyncObject.Start and wait fro the SyncObject.SyncEnd event to fire.