When you use a userform in VBA to send an email is there an option to conditionally add an attachment?
Let's say
if checkboxes 1 & 2 are checked, IMG1 will be attached
if checkbox 3 is checked, IMG2 will be attached
If checkboxes 1, 2 and 3 are checked, IMG1 and IMG2 will be attached
Private Sub CommandButton1_Click()
Dim AppOutlook As Outlook.application
Dim Mailtje As Outlook.MailItem
Dim strbody As String
Set AppOutlook = CreateObject("Outlook.Application")
Set Mailtje = AppOutlook.CreateItem(olMailItem)
Mailtje.Display
Mailtje.To = TextBox1.Value
Mailtje.CC = TextBox2.Value
Mailtje.Subject = "Test" & Format(Date, "dd/mm/yy")
Mailtje.HTMLBody = strbody
.Attachments.Add = IMG1.jpg
End Sub
Something like this:
If checkbox1.Value And checkbox2.Value Then
Mailtje.Attachments.Add "C:\Test\Pic1.jpg" 'use the full path
End If
If checkbox3.Value Then
Mailtje.Attachments.Add "C:\Test\Pic2.jpg"
End If
Related
The Word doc has a button with this VBA code that sends it to a specific email address in the to field and another email address in the CC field. The CC field needs to be populated by an address that was filled in on the Word document inside a Content Control Text Box though. How do I define that variable in the following VBA code:
Private Sub CommandButton1_Click()
Dim xOutlookObj As Object
Dim xEmail As Object
Dim xDoc As Document
Application.ScreenUpdating = False
Set xOutlookObj = CreateObject("Outlook.Application")
Set xEmail = xOutlookObj.CreateItem(olMailItem)
Set xDoc = ActiveDocument
xDoc.Save
With xEmail
.Subject = "Click send"
.Body = "Click send"
.To = "sample#onmicrosoft.com"
.CC = "employee email from textBox control"
.Importance = olImportanceNormal
.Attachments.Add xDoc.FullName
.Display
End With
Set xDoc = Nothing
Set xEmail = Nothing
Set xOutlookObj = Nothing
Application.ScreenUpdating = True
End Sub
Assuming it's the first text box in your document:
Private Sub CommandButton1_Click()
Dim xOutlookObj As Object
Dim xEmail As Object
Dim xDoc As Document
Dim ccAddress As String 'Declare a string variable
Application.ScreenUpdating = False
Set xOutlookObj = CreateObject("Outlook.Application")
Set xEmail = xOutlookObj.CreateItem(olMailItem)
Set xDoc = ActiveDocument
ccAddress = xDoc.Shapes(1).TextFrame.TextRange.Text 'Store the textbox text in the variable
xDoc.Save
With xEmail
.Subject = "Click send"
.Body = "Click send"
.To = "sample#onmicrosoft.com"
.CC = ccAddress 'pass it to the CC property
.Importance = olImportanceNormal
.Attachments.Add xDoc.FullName
.Display
End With
Set xDoc = Nothing
Set xEmail = Nothing
Set xOutlookObj = Nothing
Application.ScreenUpdating = True
End Sub
I have a form with a multiline texbox, when I write a paragraph and try to copy it to outlook just as It looks in texbox with the spaces between lines but it copy all the paragraph in one line. You can see it in the images. I know that I can write the paragraph in HTML code in .HTMLBody, but that's not what I want because I want to edit that anytime I send a mail. I don't know if there is a code to do that, if not could you give me some other ideas?
Form_Enviar_Correo
Outlook Mail
Sub ENVIAR()
Dim a As Worksheet, b As Worksheet
Dim OApp As Object, OMail As Object, sbdy As String
Application.ScreenUpdating = False
Application.DisplayAlerts = False
On Error Resume Next
ChDir (ActiveWorkbook.Path)
Dest = Form_Enviar_Correo.Txt_Para.Value
Asun = Form_Enviar_Correo.Txt_Asunto.Value
CC = Form_Enviar_Correo.Txt_CC.Value
Set OApp = CreateObject("Outlook.Application")
Set OMail = OApp.CreateItem(0)
spie = "<img align=left width=80 height=90 src=https://xxxxxxxxxxxxx.png>"
sbdy = spie
With OMail
.To = Dest
.CC = CC
'.BCC = SCop
.Subject = Asun
.Body = Form_Enviar_Correo.Txt_Cuerpo.Text
.HTMLBody = sbdy
.Display
'.Send
End With
Set OMail = Nothing
Set OApp = Nothing
Application.ScreenUpdating = True
Application.DisplayAlerts = True
'MsgBox ("El mensaje se envió con éxito"), vbInformation, "AVISO"
End Sub
Assuming the lines are separated by a carriage return vbCr you can just replace them all with the HTML equivalent with one line of code using the Replace function.
Dim sText as String
sTest = "This is" & vbCr & "a test"
MsgBox sTest
Dim sHTMLFormat as String
sHTMLFormat = Replace(sTest, vbCr, "<br>")
MsgBox sHTMLFormat
so...
.HTMLBody = Replace(Form_Enviar_Correo.Txt_Cuerpo.Text, vbCr, "<br>")
They may also be separated by vbNewLine or vbCrLf or vbLf so use the one that works in your case.
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'm trying to create an Outlook Userform, where via a drop down menu an operator can select an email template.
Using this example, this is the code for the Outlook form which works fine.
Private Sub UserForm_Initialize()
With ComboBox1
.AddItem "Test"
.AddItem "Template 2"
.AddItem "Template 3"
.AddItem "Template 7"
.AddItem "Template 5"
.AddItem "Template 6"
End With
End Sub
Private Sub btnOK_Click()
lstNum = ComboBox1.ListIndex
Unload Me
End Sub
This is the code I've started to put together, to select the template. When I use the drop down menu to select the "Test Template" I receive a error here "Test.Select" highlighting an object is required.
Public lstNum As Long
Public Sub ChooseTemplate()
Dim oMail As Outlook.MailItem
Dim oContact As Outlook.ContactItem
Dim strTemplate As String
UserForm1.Show
Select Case lstNum
Case -1
' -1 is what you want to use if nothing is selected
strTemplate = "Test"
Case 0
strTemplate = "template-1"
Case 1
strTemplate = "template-2"
Case 2
strTemplate = "template-3"
Case 3
strTemplate = "template-4"
Case 4
strTemplate = "template-5"
End Select
Test.Select
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = cell.Value
.Subject = "Test Facility"
.HTMLBody = "<BODY style=font-size:11pt;font-family:Calibri>Hi " You recently confirmed you require continued use of the test facility
"<p>Many thanks and kind regards</p></BODY>" & Signature
.Sensitivity = 2
.Send
End With
On Error GoTo 0
Set OutMail = Nothing
cleanup:
Set OutApp = Nothing
Application.ScreenUpdating = True
wb.Close savechanges:=True
End If
Set oMail = Nothing
End Sub
To generate mail from a template see https://msdn.microsoft.com/VBA/Outlook-VBA/articles/application-createitemfromtemplate-method-outlook
Set MyItem = Application.CreateItemFromTemplate("C:\statusrep.oft")
Run this code in Outlook to see how to use the selection.
Public lstNum As Long
Public Sub ChooseTemplate()
Dim outMail As Outlook.MailItem
UserForm1.Show
Select Case lstNum
' Following the listbox entries
Case -1
' -1 is what you want to use if nothing is selected
Set OutMail = CreateItemFromTemplate("Path\to\test.oft")
Case 0
Set OutMail = CreateItemFromTemplate("Path\to\test.oft")
Case 1
Set OutMail = CreateItemFromTemplate("Path\to\template-2.oft")
Case 2
Set OutMail = CreateItemFromTemplate("Path\to\template-3.oft")
Case 3
Set OutMail = CreateItemFromTemplate("Path\to\template-7.oft")
Case 4
Set OutMail = CreateItemFromTemplate("Path\to\template-5.oft")
Case 5
Set OutMail = CreateItemFromTemplate("Path\to\template-6.oft")
End Select
' Use for a specific purpose not randomly
' On Error Resume Next
With OutMail
.To = "cell.Value" ' For this Outlook demo
' This should be in the template
' .Subject = "Test Facility"
' .HTMLBody = "<BODY style=font-size:11pt;font-family:Calibri>Hi " You recently confirmed you require continued use of the test facility
' "<p>Many thanks and kind regards</p></BODY>" & Signature
' .Sensitivity = 2
.Display
End With
' On Error GoTo 0
cleanup:
Set OutMail = 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