Retrieving Outlook Attachments in VBA from sent mail - vba

What I am trying to get done is to have it so that on a few E-Mail templates we have at my job, when we drag and drop a certain Excel file to it, it will select and copy a range of that Excel file into the body of the email. My only question, as I've looked everywhere and all the code I've found seems to be for emails that are being received, not written, is how do I access:
The attachments in an email that I am writing
The body of the E-Mail I am writing
I'm sure I can get the code for everything else I want once I can get the attachments for the current Email.
Before any mentions "just record the macro and see how outlook does it" for some reason my outlook does not have a "record macro" item anywhere, as that was my first go-to as well.

how do I access: The attachments in an email that I am writing The
body of the E-Mail I am writing
Here is a very basic example. I have not done any error handling but I am sure you can take care of it.
Let's say the email that you are writing looks like this
All you need is this code
Sub Sample()
Dim NewMail As MailItem, oInspector As Inspector
Set oInspector = Application.ActiveInspector
'~~> Get the current open item
Set NewMail = oInspector.CurrentItem
With NewMail
Debug.Print .To
Debug.Print .subject
Debug.Print .Body
AttchCount = .Attachments.Count
If AttchCount > 0 Then
For I = 1 To AttchCount
'~~> Print Attachment names
Debug.Print .Attachments.Item(I).DisplayName
Next I
End If
End With
End Sub
Output

Related

Edit, send and save email to file system

We currently have an email automatically created by Excel using VBA, with subject, recipient, message body with template text all filled in.
Sub CreateMail(Optional sFile As String = "")
'Create email to send to requestor with attachment sFile
'Declarations
Dim app As Outlook.Application
Dim msg As Outlook.MailItem
Dim send_to As Recipient
Dim send_tos As Recipients
'Initiations
Set app = CreateObject("Outlook.Application")
Set msg = app.CreateItem(olMailItem)
Set send_tos = msg.Recipients
Set send_to = send_tos.Add("receiver#email.com")
send_to.Type = 1
'Create message
With msg
.SentOnBehalfOfName = "sender#email.com"
.Subject = "This is the email subject"
.HTMLBody = "This is the email body" & vbCrLf
'Resolve each Recipient's name.
For Each send_to In msg.Recipients
send_to.Resolve
Next
If Len(sFile) > 0 Then
.Attachments.Add sFile
End If
.Display
End With
End sub
After making some manual changes to the email that is created, we'd like to send it and have a copy saved to a folder on the file system automatically (in addition to the usual sent folder in Outlook). Is there a way to do this all within Excel VBA?
I suspect it might be possible using Outlook VBA, however the folders are defined in Excel and we'd like to keep the code together in the one file.
What is your code for sending email? This works for me in an Excel VBA module:
Dim appOutLook As Outlook.Application
Dim MailOutLook As Outlook.MailItem
Set appOutLook = CreateObject("Outlook.Application")
Set MailOutLook = appOutLook.CreateItem(olMailItem)
With MailOutLook
.BodyFormat = olFormatRichText
.To = "email address"
.Subject = "Test"
.HTMLBody = "Test " & Now
.DeleteAfterSubmit = True 'to not retain in sent folder
.Display
.SaveAs "C:\filepath\Test.txt", 0
' .Send
End With
However, guess the real trick is allowing edit of the email before saving file. So far not seeing solution for that. Unfortunately the code execution does not pause while the message window is open. I was hoping for the pause since Office is supposed to be an integrated suite of apps - like opening a form in Access in dialog mode which does pause execution of code.
With code in Excel only, monitor the SentItems folder.
Utilizing Outlook Events From Excel
Confirm the mail from a unique ID.
The unique ID could be in the subject or body.
You could try saving the unique ID in PR_SEARCH_KEY. It is the same idea How, can get the exact sent Email from Sent Items folder? and How to uniquely identify an Outlook email as MailItem.EntryID changes when email is moved

VBA Copy Email as .MSG to New Email

I am new to using VBA and I've looked around trying to find a solution. I don't know if this is even possible but I'm going to try and see if anyone can come up with any ideas.
So when you go into Outlook and you right click on an email, you can select copy. When you create a new email and paste the email, the copied email gets attached as a .msg as an attached file.
I am trying to replicate this process. Right now my process is
Find email
InStr(olMail.Subject, "SUBJECT") <> 0
Display email
olMail.Display
Copy body and set text to strPaste
Buf.SetText(OlMail.Body)
Buf.PutInClipBoard
strPaste = Buf.GetText(1)
Create new email
MailItem = OlApp.CreateItem(0)
Paste body
.Body = strPaste
This works but it isn't as clean because there are other things that are going into a message and it would be better for the copied email to be attached to an email instead of copying the body text.
I also don't want to save the email as an .msg and then attach it because other people will be using the macro and it would be quite tedious to change the path of where the email gets saved for every individual.
Any suggestions would be great!
So when you go into Outlook and you right click on an email, you can select copy. When you create a new email and paste the email, the copied email gets attached as a .msg as an attached file.
I am trying to replicate this process.
When forwarding MailItem as Attachment, use olEmbeddeditem
Which the Outlook message format file (.msg) is a copy of the original message to the new message.
Example in vba would be
Option Explicit
Sub Example()
'// Declare variables
Dim Msg As Outlook.MailItem
Dim Item As Outlook.MailItem
' Select Item
If Application.ActiveExplorer.Selection.Count = 0 Then
MsgBox ("No Item selected")
Exit Sub
End If
For Each Item In Application.ActiveExplorer.Selection
Set Msg = Application.CreateItem(olMailItem)
With Msg
.Attachments.Add Item, olEmbeddeditem ' Attch Selected email
.Display
End With
Next
'// Clean up
Set Item = Nothing
Set Msg = Nothing
End Sub
Select the Email that you would like to copy as .msg to new Email, then run the code

VB macro in Word to phone home

I am looking for a VB Script that will "phone home" if the document is open. I have created an empty macro named AutoOpen which executes properly when the document is open.
I would like to collect the time, current user logged in, and computer name and then automatically send an email address with that information. Basically to see who is opening that document.
Is there a way to do that with VB in word?
I haven't seen any php like function calls that send an email out for example mail("blahblah#mail.com", "mysubject", "my text"); That is kind of what I am looking for but in VB
Here is my email code that I use ALL the time.
Sub EmailCopy()
Dim oApp, oMail As Object
On Error Resume Next
Set oApp = CreateObject("Outlook.Application")
Set oMail = oApp.CreateItem(0)
With oMail
.To = "Someone#Somewhere.com.au"
.Subject = "My Subject Title"
.Body = "Here is the information you asked for"
.Send
End With
Set oMail = Nothing
Set oApp = Nothing
End Sub
Try to implement it into your code and post back if you get stuck. You will need a reference to outlook (I am assuming you are sending via outlook? if not you need to use the CDO method posted by Mat's Mug)
Also maybe remove the vbscript tag from your question, this is VBA :)

Outlook 2013: select multiple emails and autoreply using template

I am trying to get this code to work.
I want to select multiple emails from my inbox and send a auto reply using a template.
I am getting a run-time error: Object variable or With Block variable not set.
Any help would be appreciated. Also I would like to add a msg box telling me how many items were sent.
Option Explicit
Sub ReplywithTemplate()
Dim Item As Outlook.MailItem
Dim oRespond As Outlook.MailItem
For Each Item In ActiveExplorer.Selection
' This sends a response back using a template
Set oRespond = Application.CreateItemFromTemplate("C:\Users\Accounting\AppData\Roaming\Microsoft\Templates\scautoreply.oft")
With oRespond
.Recipients.Add Item.SenderEmailAddress
.Subject = Item.Subject
' includes the original message as an attachment
.Attachments.Add Item
' use this for testing, change to .send once you have it working as desired
.Display
End With
On Error Resume Next
Next
Set oRespond = Nothing
End Sub
I have noticed the following lines of code:
For Each oRespond In ActiveExplorer.Selection
' This sends a response back using a template
Set oRespond = Application.CreateItemFromTemplate("C:\Users\Accounting\AppData\Roaming\Microsoft\Templates\scautoreply.oft")
With oRespond
You need to use a new variable for creating an auto-reply email from a template because the selected Outlook item is missed (replaced with a newly created one).
So, basically you can create an item from a template, add recipients from the selected Outlook item and call the Send method. Or you can use the Reply method of the selected item in Outlook, copy the required properties from a template and call the Send method. It is up to you which way is to choose.
Finally, you may find the Getting Started with VBA in Outlook 2010 article helpful.

Outlook - Forward selected items as attachments macro - issue with forward symbol

I found the below code from a very helpful post by user thommck. It forwards selected items as attachments in separate emails to a specified recipient.
When I use the code, the forward symbol does not appear on the email icon of the email I just forwarded. If I use the regular Outlook method for "Forward as Attachment," the symbol is added to the envelope icon in my viewing pane.
Any ideas on how to get this forward symbol to appear when using this code?
Sub ForwardSelectedItems()
On Error Resume Next
Dim objItem As Outlook.MailItem
If Application.ActiveExplorer.Selection.Count = 0 Then
MsgBox ("No item selected")
Exit Sub
End If
For Each objItem In Application.ActiveExplorer.Selection
Set objMsg = Application.CreateItem(olMailItem)
With objMsg
.Attachments.Add objItem, olEmbeddeditem
.Subject = "enter text"
.To = "example#example.com"
.Send
End With
Next
Set objItem = Nothing
Set objMsg = Nothing
End Sub
You need to use the Forward method of the MailItem class instead of creating a new mail item in the code:
Application.CreateItem(olMailItem)
should be replaced with:
objItem.Foward()
Note, you need to clear the message body if you don't want to see the content of the attached item.
You may find the Getting Started with VBA in Outlook 2010 article helpful.
You can simulate pressing a button with ExecuteMso.
https://msdn.microsoft.com/en-us/library/office/ff862419%28v=office.15%29.aspx
expression.ExecuteMso(idMso)
expression An expression that returns a CommandBars object.
To find the idMso, go through the process of adding a button to the Quick Access Toolbar or a ribbon. Once you find the control in the list, hover over it until the tooltip appears. The idMso is the name in brackets.
In this case it is ForwardAsAttachment