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
Related
I have created a macro that attaches selected email to the message and sends it to the pre-populated address.
However sometimes macro stops attaching selected email.
Can anyone advise what may be the reason? Here is my code.
Sub ForwardOutsource()
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
.SentOnBehalfOfName = "info#info.com"
.Attachments.Add objItem, olEmbeddeditem
.Subject = objItem.Subject
.To = "address#address.com"
.Display
End With
Next
Set objItem = Nothing
Set objMsg = Nothing
End Sub
Well you should remove On Error Resume Next from your code, you are basically telling the code to continue to next line if an error occurred.
by the way you are not using it correctly as well
Here is good link http://www.cpearson.com/Excel/ErrorHandling.htm
Next try using Option Explicit and Declare variables
clean up your code example
Option Explicit
Public Sub Fw_Items_As_Atmt()
'// Declare variables
Dim msg As Outlook.MailItem
Dim Item As Outlook.MailItem
' Select msg
If Application.ActiveExplorer.Selection.Count = 0 Then
MsgBox ("No Item selected")
Exit Sub
End If
Set msg = Application.CreateItem(olMailItem)
For Each Item In Application.ActiveExplorer.Selection
With msg
.Attachments.Add Item, olEmbeddeditem ' Attch Selected email
.Subject = "See Attached Items"
.To = ""
.CC = ""
.HTMLBody = ""
.Display
' .Send
End With
Next
'// Clean up
Set Item = Nothing
Set msg = Nothing
End Sub
I want my email template to prompt me for input, and replace specified fields with my input.
For example my email will be like:
Hello [name]
I want a box to pop up where I can enter the name and have it appear throughout the email, replacing [name].
Using my example, by saving "#0#" in your template in the "to:" section of the email, by clicking this template it will prompt you to change that entry with the "Email Address" question.
Sub CommandButton1_Click()
Call OpenTemplate
End Sub
Sub OpenTemplate()
Dim OutMail As Outlook.MailItem
Set OutMail = Application.CreateItemFromTemplate("Template Location")
On Error Resume Next
With OutMail
.To = Replace(.To, "#0#", InputBox("Email Address"))
.CC = ""
.BCC = ""
.Subject = Replace(.Subject, "#1#", InputBox("Prompt 1"))
.Body = Replace(.Body, "#2#", InputBox("Prompt 2"))
.Body = Replace(.Body, "#3#", InputBox("Prompt 3"))
.Body = Replace(.Body, "#4#", InputBox("Prompt 4"))
.Display
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
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
I am looking to have my spreadsheet send emails once a cell changes.
Thus far I have a macro to send to a group of emails and a command button macro to trigger this, but would like it to happen automatically when a cell changes state.
Now I have:
Sub Create_Email_From_Excel()
Dim SendTo As String
Dim ToMSg As String
For i = 1 To 10
SendTo = ThisWorkbook.Sheets(1).Cells(i, 1)
If SendTo <> “” Then
ToMSg = ThisWorkbook.Sheets(1).Cells(i, 3)
Send_Mail_From_Excel SendTo, ToMSg
End If
Next i
End Sub
Sub Send_Mail_From_Excel(SendTo As String, ToMSg As String)
Dim OutlookApp As Object
Dim OutlookMail As Object
Set OutlookApp = CreateObject("Outlook.Application")
Set OutlookMail = OutlookApp.CreateItem(0)
With OutlookMail
.To = SendTo
.CC = "john#interwebs.com"
.BCC = “”
.Subject = "You have mail"
.Body = "this is your mail"
.Send
End With
And...
Private Sub CommandButton1_Click
Create_Email_From_Excel
End Sub
I'm not sure where to go from here or if I'm going in the right direction. The command button and macros work but I am at a loss to go any further.
If it could excecute the create email from excel macro when a cell in column G changes from "pending" to "Late" that would be outstanding.
Try Worksheet_Change event
Example
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$G$1" Then
'
'When someone Edits the cell G1
'
Call Create_Email_From_Excel
'
'
End If
End Sub
I create a new email with the code below.
I'd like to have an attachment. I think I have to use an OutMail.Attachment.Method but the attachment needs to be a specific email.
I want the entire email with contents (ie. texts, files, pics, etc.) as the attachment.
I'd like to attach whatever email I have highlighted (as an .msg).
Public Sub RemarkRequest()
Dim OutApp As Object
Dim OutMail As Object
Dim Signature As String
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
'Get the user signature
With OutMail
.Display
End With
Signature = OutMail.HTMLBody
'Change the mail address and subject in the macro before you run it.
With OutMail
.To = "yyy#bbb.com; zzz#bbb.com"
.CC = ""
.BCC = ""
.Subject = "Subject"
.HTMLBody = "Text" & Signature
.Display
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
Example will be -
'// Forces explicit declaration of all variables in a file
Option Explicit
Sub ForwardAsAttchment()
'// Declare variables
Dim olMsg As Outlook.MailItem
Dim olItem As Outlook.MailItem
Dim olSignature As String
On Error Resume Next
If Application.ActiveExplorer.Selection.Count = 0 Then
MsgBox ("No Item selected")
Exit Sub
End If
For Each olItem In Application.ActiveExplorer.Selection
Set olMsg = Application.CreateItem(olMailItem)
'// Get the user signature
With olMsg
.Display
End With
olSignature = olMsg.HTMLBody
'// Change the mail address and subject in the macro before you run it.
With olMsg
.Attachments.Add olItem, olEmbeddeditem ' Attch Selected email
.Subject = "Subject"
.To = "yyy#bbb.com; zzz#bbb.com"
.CC = ""
.BCC = ""
.HTMLBody = "Text" & olSignature
.Display
' .Send
End With
Next
'// Clean up
Set olItem = Nothing
Set olMsg = Nothing
End Sub