I regularly issue Purchase Orders to vendors for my job, and either;
Write the email like a normal person or;
Use a macro to open a template that I have generated
Sub New_Email_from_PO_Template()
Dim myOlApp As Outlook.Application
Dim MyItem As Outlook.MailItem
Set myOlApp = CreateObject("Outlook.Application")
Set MyItem = myOlApp.CreateItemFromTemplate("C:\Blah\template.oft")
MyItem.Display
End Sub
My aim is to eliminate the possibility of error by creating a userform, which will then populate a New E-mail window, allowing me to make any desired changes, and add attachments, before manually clicking [Send].
Included here is a Userform I have created.
The textboxes in the Userform that I have created are as follows;
RecipientName
PurchaseOrderNumber
PurchaseOrderDescription
Location
ProjectNumber
DateRequired
Following [SubmitButton], the data would then be populated into the Subject and Body fields in the New E-mail window.
Subject Line:
"PO# [PurchaseOrderNumber] - [PurchaseOrderDescription] - [Location]"
Body:
"To [Recipient_Name],
Please find attached Purchase Order (PO# [PurchaseOrderNumber]) pertaining to [PurchaseOrderDescription] for [Location]. Date Required: [DateRequired]
Thanks and Kind Regards, [User's Outlook Signature]"
The code I have developed is below;
Sub ShowPOSubmissionUserform()
POSubmissionEmailGenerator.Show
End Sub
Sub InitialisePOSubmissionUserform()
'Empty ProjectNumberTextbox
ProjectNumberTextbox.Value = ""
'Empty ProjectNameTextbox
ProjectNameTextbox.Value = ""
'Empty PONumberTextbox
PONumberTextbox.Value = ""
'Empty RecipientNameTextbox
RecipientNameTextbox.Value = ""
'Empty DateRequiredTextbox
DateRequiredTextbox.Value = ""
End Sub
Private Sub CloseButton_Click()
Unload Me
End Sub
Private Sub SubmitButton_Click()
'Creates a new e-mail item and modifies its properties
Dim OutlookApp As Object
Dim MItem As Object
Dim email_ As String
Dim subject_ As String
Dim body_ As String
Dim attach_ As String
Set OutlookApp = CreateObject("Outlook.Application")
email_ = POSubmissionEmailGenerator.ProjectNumberTextbox.Value
subject_ = "Hello this is the subject"
body_ = "Line 1" & vbNewLine & vbNewLine & "Line 3"
'create Mail Item and send it
Set MItem = OutlookApp.CreateItem(0)
With MItem
.To = email_
.Subject = subject_
.Body = body_
End With
End Sub
At the moment, when pressing submit, NOTHING happens.
What needs to be added to make it at least open the New E-mail window?
With MItem
.To = email_
.Subject = subject_
.Body = body_
.Display '<<
End With
Related
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
I want to automatically create a greeting with the recipient's first name, on new messages.
For example, it should check the "To" field and if there is an email address, take the First Name from the contact and fill in the body of the message (ex. Dear [First Name],).
I don't know which method or event to use if I press New Message and which method or event to use to see if a recipient is added. (The macro should run every time a recepient is added.) If there are more then two recipients should be "Hello everyone,"
For a reply I am using the "Reply" event that occurs when the user selects the reply action.
Private Sub GMailItem_Reply(ByVal Response As Object, Cancel As Boolean)
AutoAddGreetingToReply Response
End Sub
This finds the recipient name and adds a greeting to the reply message.
I also tried with a Word document that contains merge fields to mail merge but it doesn't work. Here is the code that I am using for email merge.
Option Explicit
Public Sub MailMergeAttachments()
Dim Session As Outlook.NameSpace
Dim currentExplorer As Explorer
Dim Selection As Selection
Dim oContact As ContactItem
Dim oMail As MailItem
Dim attach As Attachment
Dim obj As Object
Dim oWord As Word.Application
Dim oDoc As Word.Document
Dim tmp As String
' Uses current user's profile
Dim enviro As String
enviro = CStr(Environ("USERPROFILE"))
' Get Word
Set oWord = GetObject(, "Word.Application")
Set oDoc = oWord.Documents(1)
tmp = oDoc.FullName
oDoc.Activate
oWord.Visible = True
Set currentExplorer = Application.ActiveExplorer
Set Selection = currentExplorer.Selection
If Not TypeOf Selection.Item(1) Is Outlook.ContactItem Then
MsgBox "You need to select Contacts first!"
Exit Sub
End If
For Each obj In Selection
'Test for ContactGroups
If TypeName(obj) = "ContactItem" Then
Set oContact = obj
Dim mText As String
Dim f As Word.Field
For Each f In oDoc.Fields
If f.Type = wdFieldMergeField Then
' match Word mergefields with Outlook fields
Select Case f.Code
Case " MERGEFIELD First "
mText = oContact.FirstName
Case " MERGEFIELD Last "
mText = oContact.LastName
Case " MERGEFIELD Company "
mText = oContact.CompanyName
End Select
f.Result.Text = mText
End If
Next
Set oMail = Application.CreateItem(olMailItem)
With oMail
.To = oContact.Email1Address
.Subject = Left(oDoc.Name, Len(oDoc.Name) - 5)
'The content of the document is used as the body for the email
.Body = oDoc.Content
.Attachments.Add enviro & "\Documents\instructions.pdf"
.Display ' .send
End With
End If
Next
Set oWord = Nothing
Set Session = Nothing
Set currentExplorer = Nothing
Set obj = Nothing
Set Selection = Nothing
End Sub
How do I run a macro when I select new message and how do I run it repeatedly when I enter new recipient/s and add personalised greeting in the body of the message?
Every day I receive several automated e-mails which contain some information that needs to be forwarded to another e-mail address(es).
This e-mail address is in the automated e-mail, and will not always be the same. This e-mail address is located in a table, under the row labeled "Remarks". I've inserted a picture to illustrate this.
I would like to automate this process using Outlook VBA Macros. Some additional information:
1) I cannot use the "run a script" function under Rules.
2) The incoming e-mails are automated and will always be the same format.
What I need help is in:
1) Copying the e-mail address in the next column of the "remarks" row.
I have already managed to automate the process of recognizing the incoming e-mail (by its subject title) and auto-forwarding it to a predefined e-mail address and changing the forwarded email subject title.
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")
'Setting target folder as inbox
Set Items = objectNS.GetDefaultFolder(olFolderInbox).Items
End Sub
Private Sub Items_ItemAdd(ByVal Item As Object)
On Error GoTo ErrorHandler
Dim Msg As Outlook.Mailitem
'act only if it is a mail item
If TypeName(Item) = "MailItem" Then
Set Msg = Item
'Detect emails with specified subject title
If Msg.Subject = "Test" Then
Set myForward = Item.Forward
myForward.Recipients.Add("test#gmail.com")
myForward.Subject = "FW: Success"
myForward.Save
myForward.Send
EndIf
EndIf
ProgramExit: Exit Sub
ErrorHandler:
MsgBox Err.Number & "-" & Err.Description
Resume ProgramExit
End Sub
According to my understand, You want to get address in email body.
You could use the below code:
Option Explicit
Sub Example()
Dim Item As MailItem
Dim RegExp As Object
Dim Search_Email As String
Dim Pattern As String
Dim Matches As Variant
Dim len1 As String
Dim result As String
Set RegExp = CreateObject("VbScript.RegExp")
Pattern = "remarks\s+(\b[A-Z0-9._%+-]+\b)"
For Each Item In ActiveExplorer.Selection
Search_Email = Item.Body
With RegExp
.Global = False
.Pattern = Pattern
.IgnoreCase = True
Set Matches = .Execute(Search_Email)
End With
If Matches.Count > 0 Then
len1 = Matches(0).Length() - 8
result = Mid(Matches(0), 12, len1)
result = result + "#gmail.com"
MsgBox result
Debug.Print Matches(0)
Else
Debug.Print "Not Found "
End If
Next
Set RegExp = Nothing
End Sub
For more information, you could refer to this link:
Extract Email address from a table in .HTMLbody
I'm trying to create a template where I can have VBA prompt me to change items in the subject. I've a template email with the subject line that should be Project / GC/Client, and in the template I've written that as #0# / #1#.
I'm at the below, but it's erroring.
Private Sub m_Inspector_Activate()
Dim Item As MailItem
Dim Value As String
If TypeOf m_Inspector.CurrentItem Is MailItem Then
Set mail = m_Inspector.CurrentItem
If mail.Subject = "subject" Then
Value = InputBox("Project")
mail.Subject = Replace(mail.Subject, "#0#", Value)
Value = InputBox("GC/Client")
mail.Subject = Replace(mail.Subject, "#1#", Value)
End If
End If
End Sub
This code is used on a template button in Outlook. i.e. the template file it is launching contains the subject line of #0# / #1#. Ideally, after the template launches, the macro prompts the user to update those two fields with the proper subjects.
Sub CommandButton1_Click()
Set MyItem = Application.CreateItemFromTemplate _
("V:\All Folders\Templates\Freebie.oft")
MyItem.Display
End Sub
If all that you really want to do is open a template and replace text in the subject line, this may work for you:
Sub CommandButton1_Click()
Call OpenTemplate
End Sub
Sub OpenTemplate()
Dim OutMail As Outlook.MailItem
Set OutMail = Application.CreateItemFromTemplate("V:\All Folders\Templates\Freebie.oft")
On Error Resume Next
With OutMail
.To = ""
.CC = ""
.BCC = ""
.Subject = Replace(.Subject, "#0#", InputBox("Project"))
.Subject = Replace(.Subject, "#1#", InputBox("GC/Client"))
.Display
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
If we can avoid using the Inspector then this is much simpler
I am trying to send an email that will update users of changes to a spread sheet. I am trying to make it so that when the document is saved there will be an email automatically sent with a list of the changes.
Does anyone know if it is possible to automate email upon saving the document?
You can use this code here not fancy as Chip Pearson but easy to understand, This method also relies on using outlook:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim Outlook As Object, EMail As Object
Set Outlook = CreateObject("Outlook.Application")
Set EMail = Outlook.CreateItem(0)
With EMail
.To = "EmailAddress1#Server.com; Email2#aol.com"
.CC = ""
.BCC = ""
.Subject = "Put your subject here"
.Body = "Add you E-Mail Message Here"
.Attachments.Add ActiveWorkbook.FullName ' To add active Workbook as attachment
.Attachments.Add "C:\Test.xlsx" ' To add other files just use path, Excel files, pictures, documents pdf's ect.
.Display 'or use .Send to skip preview
End With
Set EMail = Nothing
Set Outlook = Nothing
End Sub
To set this up Here is the full guide:
First open up the VBA window using ALT + F11 then Select Worbook on the window to the right, Then workbook from the drop down:
Then from the Drop down on the right Select BeforeSave:
Then paste your code there:
You should end with this:
It should be. You'll need to place your code in the Workbook_BeforeSave event, so it is triggered when the workbook is saved.
Chip Pearson has a good article on Sending E-mail from VBA
You need to put the code in ThisWorkbook code section. Workbook_BeforeSave event is triggered before workbook is save. Hope below code gives you an idea how it can be accomplished.
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
' Identify here list of changes
' You can pass as a string to SendMail
Dim strChanges As String
strChanges = "test"
SendMail strChanges
End Sub
Sub SendMail(msg As String)
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
'Configure the below details
With Flds
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "test-002"
.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 = "msg" & " " & Date & " " & Time
.TextBody = msg
.Send
End With
Set iMsg = Nothing
Set iConf = Nothing
End Sub