Macro doesn't show open mail - vba

Below is my macro to send an email but it does not open a new email .
This macro is in the outlook rules.
Have you any ideas?
Sub sendemail()
Dim ns As NameSpace
'Dim newMail As Outlook.MailItem
Set ns = GetNamespace("MAPI")
Dim newMail As MailItem
Set newMail = Application.CreateItem()
With newMail
.To = "aaa#bbb" <--adress to whitch I want to send an email
.Subject = "test"
.Display
End With
Set newMail = Nothing
End Sub

first you need to add up the outlook reference:
There you go:
then:
Sub sendemail()
Dim outlook As New outlook.Application
Dim newMail As outlook.MailItem
Set newMail = outlook.CreateItem(olMailItem)
With newMail
.To = "email#address.com" ' <--adress to whitch I want to send an email
.Subject = "test from Steph"
.Display
.Send
End With
Set newMail = Nothing
outlook.Quit
Set outlook = Nothing
End Sub

Argument must be type MailItem or MeetingItem for the subroutine to be available in Outlook Rules Wizard.
Try this.
Option Explicit
Sub SendEmail(NewMail As Outlook.MailItem)
Set NewMail = Application.CreateItem(olMailItem)
With NewMail
.To = "aaa#bbb" '<--adress to whitch I want to send an email
.Subject = "test"
.Display
End With
Set NewMail = Nothing
End Sub

Youre not specifying the item to create. See here:
Private Sub SendEmail(ByVal workcenter As Integer, ByVal time As Date)
Dim objApp As Object
Dim objEmail As Object
Set objApp = CreateObject("Outlook.Application")
Set objEmail = CreateObject("Outlook.MailItem")
With objEmail
.To = "emailexampe#website.com"
.Subject = "Multiple Shop Orders run for line " & workcenter & " at " & time
.body = "TEST"
.display
End With
Set objEmail = Nothing
Set objApp = Nothing
End Sub
Source: http://www.vbforums.com/showthread.php?536558-RESOLVED-Outlook-late-binding
this version also uses late binding, so you dont need any additional references.

Related

Reply all with attachment

I have this code to a vba outlook macro to reply all.
Sub my_test()
Dim objItem As Object
Dim mail As MailItem
Dim replyall As MailItem
Dim templateItem As MailItem
For Each objItem In ActiveExplorer.Selection
If objItem.Class = olMail Then
Set mail = objItem
Set replyall = mail.replyall
Set templateItem = CreateItemFromTemplate("C:\template.oft")
With replyall
.HTMLBody = templateItem.HTMLBody & .HTMLBody
.Display
End With
End If
Next
End Sub
I am trying to add a functionality so that when the original email brings an attachment (docx, pdf), when I reply all using this macro it will also use the original attachment and place it as an attachment in the reply all email.
How can I achieve this?
Forward then populate the .To with what would appear in a ReplyAll.
Option Explicit
Sub my_test()
Dim objItem As Object
Dim mail As MailItem
Dim forwardMail As MailItem
Dim templateItem As MailItem
For Each objItem In ActiveExplorer.Selection
If objItem.Class = olMail Then
Set mail = objItem
Set forwardMail = mail.Forward
Set templateItem = CreateItemFromTemplate("C:\template.oft")
With forwardMail
.HTMLBody = templateItem.HTMLBody & .HTMLBody
.To = mail.replyall.To
.Display
End With
End If
Next
End Sub

Set an email has replied - vba

I have macro to forward an email with the original attachment to everyone which is involved in the original email chain.
Sub my_test()
Dim objItem As Object
Dim mail As MailItem
Dim forwardMail As MailItem
Dim templateItem As MailItem
For Each objItem In ActiveExplorer.Selection
If objItem.Class = olMail Then
Set mail = objItem
Set forwardMail = mail.Forward
Set templateItem = CreateItemFromTemplate("C:\template.oft")
With forwardMail
.HTMLBody = templateItem.HTMLBody & .HTMLBody
.To = mail.replyall.To & mail.replyall.CC
.Display
End With
End If
Next
End Sub
Is it possible to mark this email has "replied" instead of "forwarded" email?
yes you need only to change Set forwardMail = mail.Forward to Set forwardMail = mail.Reply
You should also change name of variable forwardMail to replyMail and change all variables in code. full code below.
Sub my_test()
Dim objItem As Object
Dim mail As MailItem
Dim replyMail As MailItem
Dim templateItem As MailItem
For Each objItem In ActiveExplorer.Selection
If objItem.Class = olMail Then
Set mail = objItem
Set replyMail = mail.Reply
Set templateItem = CreateItemFromTemplate("C:\template.oft")
With replyMail
.HTMLBody = templateItem.HTMLBody & .HTMLBody
.To = mail.replyall.To & mail.replyall.CC
.Display
End With
End If
Next
End Sub
If you mean you want to change the icon to the one that represents "replied", you can change it in the following way...
' Set property PR_ICON_INDEX to 261
objItem.PropertyAccessor.SetProperty "http://schemas.microsoft.com/mapi/proptag/0x10800003", 261
objItem.Save

How to create a mailitem?

I'm trying to send the active Excel workbook as an attachment via Outlook.
Whenever I run the code it says
Invalid use of New key word
at New Outlook.MailItem`.
Sub SendOutlook()
'Declaring Variables
Dim OutlookApp As Outlook.Application
Dim OutlookEmail As Outlook.MailItem
'Assigning variables to create outlook application and mailitem
Set OutlookApp = New Outlook.Application
Set OutlookEmail = New Outlook.MailItem
With OutlookEmail
'Format of the mail
.BodyFormat = olFormatPlain
'Body of the mail
.Body = "Dear Someone" & vbNewLine & "How are you?"
'To whom you want to send mail
.To = "Someone#somewhere.com"
'Subject of mail
.Subject = "Write Subject Here"
'TO add an attachment
.Attachments.Add ActiveWorkbook.FullName
'sends the mail
.Send
End With
End Sub
You cannot create a MailItem via New. It must be created using CreateItem of the the Outlook Application Object.
Set OutlookApp = New Outlook.Application
Set OutlookEmail = OutlookApp.CreateItem(olMailItem)
As far as I got to know from the research is that Programmatic access to sending emails is a security risk, so it's not allowed via VBA.
You can use a programmatic approach with the following:
Option Explicit
Private outlook_app As Object
Private outlook_mailItem As Variant
Sub send_email()
Set outlook_app = CreateObject("Outlook.Application")
With outlook_app.CreateItem(outlook_mailItem)
.To = "Someone#somewhere.com"
.Subject = "Write Subject Here"
.Body = "Dear Someone" & vbNewLine & "How are you?"
.send
End With
Set outlook_app = Nothing
End Sub

Activating specific email in Outlook with VBA & deleting signature from the copied text

I'm looking to use the get function in vba in order to activate a specific email in Outlook and then copy the body into a new email and send. I can use the getlast function to get the latest email in the inbox, however I would like to refine the code some more by selecting the latest email from a specific email address.
Also, I'd love how to know how to delete the signature from the text pasted into the new email.
Sub Negotiations()
Dim objMsg As Outlook.MailItem
Dim objItem As Outlook.MailItem
Dim BodyText As Object
Dim myinspector As Outlook.Inspector
Dim myItem As Outlook.MailItem
Dim NewMail As MailItem, oInspector As Inspector
Set myItem = Application.Session.GetDefaultFolder(olFolderInbox).Items.GetLast
myItem.Display
'copy body of current item
Set activeMailMessage = ActiveInspector.CurrentItem
activeMailMessage.GetInspector().WordEditor.Range.FormattedText.Copy
' Create the message.
Set objMsg = Application.CreateItem(olMailItem)
'paste body into new email
Set BodyText = objMsg.GetInspector.WordEditor.Range
BodyText.Paste
'set up and send notification email
With objMsg
.To = "#gmail.com"
.Subject = "Negotiations"
.HTMLBody = activeMailMessage.HTMLBody
.Display
End With
End Sub
any help would be appreciated, thank you guys!
Open the Inbox folder using Namespace.GetDefaultFolder(olFolderInbox), retrieve the Items collection from MAPIFolder.Items. Sort the items (Items.Sort) on the ReceivedTime property, retrieve the latest email using Items.Find on the SenderEmailAddress property.
Dependant on what your property of .SenderEmailAddress returns, you can adapt what the while statement evaluates for. This should work for you, by first looking at the last e-mail, and then checking each previous e-mail for the correct sender address.
Sub display_mail()
Dim outApp As Object, objOutlook As Object, objFolder As Object
Dim myItems As Object, myItem As Object
Dim strSenderName As String
Set outApp = CreateObject("Outlook.Application")
Set objOutlook = outApp.GetNamespace("MAPI")
Set objFolder = objOutlook.GetDefaultFolder(olFolderInbox)
Set myItems = objFolder.Items
strSenderName = UCase(InputBox("Enter the e-mail Alias."))
Set myItem = myItems.GetLast
While Right(myItem.SenderEmailAddress, Len(strSenderName)) <> strSenderName
Set myItem = myItems.GetPrevious
Wend
myItem.Display
End Sub
Application.Session.GetDefaultFolder(olFolderInbox).Items.GetLast
activeMailMessage.GetInspector().WordEditor.Range.FormattedText.Copy
First of all, I'd recommend breaking the chain of calls. Declare each property or method call on a separate line of code, so you will be able to debug the code at any time and see what happens under the hood.
The GetLast method returns the last object in the collectio. But it doesn't mean that the item is recieved last. You need to sort the collection using the Sort method as Dmitry suggested passing the ReceivedTime property as a parameter to sort on. Only in that case you will get the last recieved item from the collection.
The Outlook object model doesn't provide any special method or property for identifying signatures. You need to parse the message body and find it programmatically.
Sub Nego()
Dim objMsg As Outlook.MailItem
Dim myItem As Outlook.MailItem
Dim BodyText As Object
Dim Inspector As Outlook.MailItem
Dim olNameSpace As Outlook.NameSpace
Dim olfolder As Outlook.MAPIFolder
Dim msgStr As String
Dim endStr As String
Dim endStrStart As Long
Dim endStrLen As Long
Dim myItems As Outlook.Items
'Access folder Nego
Const olFolderInbox = 6
Set objOutlook = CreateObject("Outlook.Application")
Set objNamespace = objOutlook.GetNamespace("MAPI")
Set objInbox = objNamespace.GetDefaultFolder(olFolderInbox)
strFolderName = objInbox.Parent
Set objMailbox = objNamespace.Folders(strFolderName)
Set objFolder = objMailbox.Folders("Nego")
'Mark as read
For Each objMessage In objFolder.Items
objMessage.UnRead = False
Next
'Sort
Set myItems = objFolder.Items
For Each myItem In myItems
myItems.Sort "Received", False
Next myItem
myItems.GetLast.Display
'copy body of current item
Set activeMailMessage = ActiveInspector.CurrentItem
activeMailMessage.GetInspector().WordEditor.Range.FormattedText.Copy
' Create the message.
Set objMsg = Application.CreateItem(olMailItem)
'paste body into new email
Set BodyText = objMsg.GetInspector.WordEditor.Range
BodyText.Paste
'Search Body
Set activeMailMessage = ActiveInspector.CurrentItem
endStr = "first line of signature"
endStrLen = Len(endStr)
msgStr = activeMailMessage.HTMLBody
endStrStart = InStr(msgStr, endStr)
activeMailMessage.HTMLBody = Left(msgStr, endStrStart + endStrLen)
'set up and send email
With objMsg
.To = "#email"
.Subject = "Nego"
.HTMLBody = activeMailMessage.HTMLBody
.HTMLBody = Replace(.HTMLBody, "First line of signature", " ")
.Send
End With
End Sub

Send email to all contacts in Outlook address book when a new email received (VB)

I want to write a VBA script that when Outlook receive a new email from a specific email address , the VBA script has to detect that and resend the new received email to all contacts in the address book .
For now i was able to send an email to all contacts in address book :
Sub SendEmails()
Dim ContactsFolder As Folder
Set ContactsFolder = Session.GetDefaultFolder(olFolderContacts)
Dim Contact As Object
Dim olApp As Outlook.Application
Dim objMail As Outlook.MailItem
Set olApp = Outlook.Application
For Each Contact In ContactsFolder.Items
Set objMail = olApp.CreateItem(olMailItem)
With objMail
.Subject = "Subject of the received email"
.Body = "Body of the received email"
.To = Contact.Email1Address
.Send
End With
Next
End Sub
but how to use this script so it called when a new email received from a specific email address.
i tried to put this in ThisOulookSeassion to check for new message event so i could call my above code within it :
Private Sub Application_NewMail()
MsgBox "New mail"
End Sub
but it didn't work.
Also i tried this (i put it in ThisOulookSeassion too) :
Private WithEvents Items As Outlook.Items
Private Sub Application_Startup()
Dim olApp As Outlook.Application
Dim objNS As Outlook.NameSpace
Set olApp = Outlook.Application
Set objNS = olApp.GetNamespace("MAPI")
' default local Inbox
Set Items = objNS.GetDefaultFolder(olFolderInbox).Items
End Sub
Private Sub Items_ItemAdd(ByVal item As Object)
On Error Goto ErrorHandler
Dim Msg As Outlook.MailItem
If TypeName(item) = "MailItem" Then
Set Msg = item
' ******************
' and placing my code here.
' ******************
End If
ProgramExit:
Exit Sub
ErrorHandler:
MsgBox Err.Number & " - " & Err.Description
Resume ProgramExit
End Sub
but when i click run it ask me to create new macro and don't run the code.
Any suggestions ?
The simplest way is to create a rule in Outlook. Then you can assign an existing VBA macro to run when the rule is run. Typically a VBA sub should like the following one:
Sub SendEmails(mail as MailItem)
Dim ContactsFolder As Folder
Set ContactsFolder = Session.GetDefaultFolder(olFolderContacts)
Dim objMail as MailItem
Dim Contact As Object
For Each Contact In ContactsFolder.Items
Set objMail = olApp.CreateItem(olMailItem)
With objMail
.Subject = mail.Subject
.Body = "Body Text"
.To = Contact.Email1Address
.Send
End With
Next
End Sub
Also you may consider adding recipients to the Recipients collection and set their Type to the olBCC value. Thus, each of them will recieve a separate email and you have to submit only a single mail item.