Hello I have the following code written below to automatically send an email confirming that the user has filled out a form. Currently I have a powerpoint with one submit button which sends an automatic email. I also have a textbox named serial number where the user enters the part serial number.
I want to be able to send a copy of the filled out powerpoint form and have it named after the serial number. I am struggling to be able to save the textbox information as a variable. Does anyone know how to make the below functional. I apologize as I am fairly new to VBA.
Private Sub CommandButton1_Click()
Dim OL As Object
Dim EmailItem As Object
Dim Powerpoint As Presentation
Dim SerialNumtext As String
Dim FinalName As String
SerialNumtext = ActivePresentation.SelectContentControlsByTitle("SerialNumber")(1).Range.Text
FinalName = "Part Number" & SerialNumtext
Set OL = CreateObject("Outlook.Application")
Set EmailItem = OL.CreateItem(olMailItem)
Set Powerpoint = ActivePresentation
Powerpoint.Save
With EmailItem
.Subject = "SUBJECT LINE"
.Body = "BODY MESSAGE" & vbCrLf & _
"SECOND LINE BODY MESSAGE" & vbCrLf & _
"THIRD LINE BODY MESSAGE"
.To = "enduseremail"
.Importance = olImportanceNormal
'send the email with the powerpoint named after the serial number
.Attachments.Add Powerpoint.FinalName
.Send
End With
Set Powerpoint = Nothing
Set OL = Nothing
Set EmailItem = Nothing
End Sub
Powerpoint doesn't have a SelectContentControlsByTitle method; instead, you'd access the control and its text like:
SerialNumtext = ActivePresentation.Slides(1).Shapes("SerialNumber").OLEFormat.Object.Text
This assumes the control is on Slide 1.
If you'd rather not make that assumption but can assume that the Submit button and text box are on the same slide:
SerialNumText = Me.Shapes("SerialNumber").OLEFormat.Object.Text
Me in this case returns a reference to the slide object that contains the control.
Related
In windows 7 and Office 2007 I have been using a code which opens a new email in Outlook, attach a file and send it. The code it's not mine, I found it somewhere in the internet. The problem is that now I use Windows 10 and Office 2016, and using the same code produce different results as:
The original name of the file, let's say for example "Products.xlsx", is changed to "ProjectStatus.xlsx" (any file name is always changed to "ProjectStatus.xlsx")
If I open the file then Excel opens it and shows the original name of the file ("Products.xlsx")
If I send it, sometimes the recipients see the attached file as "ProjectStatus.xlsx" and sometimes see it as "Products.xlsx". But what always happens is that if they open the file, in excel is seen as "Products.xlsx"
I need the file name always be shown with the original name. How can I do this?
This is the code I use it and is executed from both access 2016 and excel 2016.
Sub MandaMailA(destinatarios As String, copia As String, subject As String, strbody As String, attachment1 As String, Optional attachment2 As String = "", Optional CO As String = "")
Dim OutApp As Object
Dim OutMail As Object
Dim SigString As String
Dim Signature As String
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
'Change only Mysig.htm to the name of your signature
SigString = Environ("appdata") & _
"\Microsoft\Firmas\VBA.htm"
If Dir(SigString) <> "" Then
Signature = GetBoiler(SigString)
Else
Signature = ""
End If
On Error Resume Next
With OutMail
.To = destinatarios
.CC = copia
.BCC = CO
.subject = subject
.HTMLBody = strbody & "<br>" & Signature
.Display 'or use .Display
.Attachments.Add attachment1, olByValue, 1, "ProjectStatus"
.Attachments.Add attachment2, olByValue, 1, "ProjectStatus"
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
I notice that this code includes the word "ProjectStatus" but honestly I have not a deep knowledge of VBA.
Thanks in advance!!
A simple read of the Attachments.Add documentation is all you need, specifically the section on the optional DisplayName parameter:
This parameter applies only if the mail item is in Rich Text format
and Type is set to olByValue : the name is displayed in an Inspector
object for the attachment or when viewing the properties of the
attachment. If the mail item is in Plain Text or HTML format, then the
attachment is displayed using the file name in the Source parameter.
So if you always want to always use the original file name, simply delete the instances of , "ProjectStatus".
I'm not a programmer so I apologize in advance.
I have three different worksheets in a workbook. Each sheet has a specific macro so that after numbers are entered, shift supervisors can press a button with the assigned macro and metrics from that sheet will be copied and pasted to a different worksheet in a format with filter-able/pivot-able columns. It then saves and closes the data, goes back to the shift report worksheet, copies the pertinent cells, then opens lotus and formats a new message with a subject line stating the correct shift number and date and pastes the shift report data into the body of the e-mail.
Since there is a different button to press on 3 worksheets, and I can't count on supervisors to enter numbers in any specific order, I need to be able to tell if Lotus has already opened and created an e-mail with that specific subject line to see if it needs to be created or if it exists with some information already in the body. Does anyone know if this is possible?
Dim NSession As Object
Dim NDatabase As Object
Dim NUIWorkSpace As Object
Dim NDoc As Object
Dim NUIdoc As Object
Dim WordApp As Object
Dim WordDoc As Object
Dim msg As String
msg = "Leads Report " & Now() & vbNewLine & vbNewLine & _
"Finishing:" & vbNewLine & _
"**PASTE Leadsheet CELLS HERE**" & vbNewLine & vbNewLine
Sheets("Leadsheet").Select
Set newRange = Range("e4")
mystring = RangeToString(newRange)
Set NSession = CreateObject("Notes.NotesSession")
Set NUIWorkSpace = CreateObject("Notes.NotesUIWorkspace")
Set NDatabase = NSession.GetDatabase("", "")
If Not NDatabase.IsOpen Then
NDatabase.OPENMAIL
End If
'Create a new document
'******************************(if statement to see
'if a document with specific subject line has already been
'created....'subject = doc.GetItemValue("subject")(0)???????
'****************************************
Set NDoc = NDatabase.createdocument
With NDoc
.SendTo = "email#email.com" 'CHANGE THIS
.CopyTo = ""
.Subject = Format(Date, "mm-dd-yyyy") & " Lead Report Shift " & mystring
'Email body text, including marker text which will be replaced by the Excel cells
.Body = msg
.Save True, False
End With
'Edit the just-created document to copy and paste the Excel cells into it
Set NUIdoc = NUIWorkSpace.editdocument(True, NDoc)
'Find the marker text in the Body item
'Replace it with the Excel cell
With NUIdoc
'leadsheet
Workbooks("Master Shift Report Sheet.xlsm").Activate
Sheets("LeadSheet").Select
Range("B2:o62").Select
ActiveWindow.zoom = 86
Selection.copy
Set WordApp = CreateObject("Word.Application")
Set WordDoc = WordApp.Documents.Add
With WordApp.Selection
.PasteSpecial DataType:=4 & vbNewLine
.wholestory
.copy
End With
.gotofield ("Body")
.findstring "**PASTE Leadsheet CELLS HERE**"
.Paste
'Application.CutCopyMode = False
'.Send
'.Close
End With
Set NSession = Nothing
anything else looks wonky don't hesitate to point it out! I'm learning.
What I have, is a similar piece of code & i made it work with the outlook editor (hard enough) and I am trying to get it to now work with Word acting as the outlook editor. (Users are used to word mail) I tried: To move the code directly into word under this document and it did nothing. To follow code i saw on: creating an objword objdoc and then pairing it with the outlook class type of deal, with no luck. Here is a sample of code:
Sub SetCategory()
Dim olMessage As Outlook.MailItem
Set olMessage = Application.ActiveInspector.CurrentItem
If olMessage.SenderName = donations Then
olMessage.Categories = "donations"
ElseIf olMessage.SenderName = "Donations" Then
olMessage.Categories = "donations"
End If
With olMessage
.Send
End With
End Sub
When using "word mail" you are not using Outlook. This describes how to invoke Outlook from Word. Once Outlook is open you can use Outlook VBA.
http://www.howto-outlook.com/howto/senddocasmail.htm
Untested, and you will have to remove the parts you do not need.
Sub SendDocAsMail()
Dim oOutlookApp As Outlook.Application
Dim oItem As Outlook.MailItem
On Error Resume Next
'Start Outlook if it isn't running
Set oOutlookApp = GetObject(, "Outlook.Application")
If Err <> 0 Then
Set oOutlookApp = CreateObject("Outlook.Application")
End If
On Error GoTo 0 ' <=== Important to see errors now if there are any
'Create a new message
Set oItem = oOutlookApp.CreateItem(olMailItem)
' --------------------------
'Set oItem = oOutlookApp.ActiveInspector.CurrentItem
If oItem.SenderName = donations Then
oItem.Categories = "donations"
ElseIf oItem.SenderName = "Donations" Then
oItem.Categories = "donations"
End If
' --------------------------
'Allow the user to write a short intro and put it at the top of the body
Dim msgIntro As String
msgIntro = InputBox("Write a short intro to put above your default " & _
"signature and current document." & vbCrLf & vbCrLf & _
"Press Cancel to create the mail without intro and " & _
"signature.", "Intro")
'Copy the open document
Selection.WholeStory
Selection.Copy
Selection.End = True
'Set the WordEditor
Dim objInsp As Outlook.Inspector
Dim wdEditor As Word.Document
Set objInsp = oItem.GetInspector
Set wdEditor = objInsp.WordEditor
'Write the intro if specified
Dim i As Integer
If msgIntro = IsNothing Then
i = 1
'Comment the next line to leave your default signature below the document
wdEditor.Content.Delete
Else
'Write the intro above the signature
wdEditor.Characters(1).InsertBefore (msgIntro)
i = wdEditor.Characters.Count
wdEditor.Characters(i).InlineShapes.AddHorizontalLineStandard
wdEditor.Characters(i + 1).InsertParagraph
i = i + 2
End If
'Place the current document under the intro and signature
wdEditor.Characters(i).PasteAndFormat (wdFormatOriginalFormatting)
'Display the message
oItem.Display
'Clean up
Set oItem = Nothing
Set oOutlookApp = Nothing
Set objInsp = Nothing
Set wdEditor = Nothing
End Sub
Edit: Added, based on comment. This is a step that beginners trip on.
"Since this macro also uses Outlook functionality to create the mail we must add the reference to the project. To do this choose Tools-> References… and select Microsoft Outlook 12.0 Object Library (or 14.0 when using Outlook 2010). After this press OK."
Latest Outlook versions use Word as an email editor by default. There is no need to check out the editor type. The WordEditor property of the Inspector class returns the Microsoft Word Document Object Model of the message being displayed. You can read more about that in the Chapter 17: Working with Item Bodies .
Also you may find the How to automate Outlook and Word by using Visual C# .NET to create a pre-populated e-mail message that can be edited article helpful.
I have a worksheet that tracks invoices and I am trying to generate an auto-emailer that if a cell in column 12 contains AUTOEMAIL it will combine all of the rows with a similar email address which I've generated using a TRIM function. It will pull all of the like rows (Email Addresses based on column 15) into a LotusNotes Email. Ron De Bruin has some fantastic examples on his site. I attempted to write a loop which attempts to loop through and copy all rows based on an email address. When I go to run, the code does nothing but no errors are presented. There are instances online of this done in Outlook, but they don't apply to LotusNotes as the issue is late vs early binding. I'm newer to VBA automation as well.
Sub Send_Data()
Dim noSession As Object, noDatabase As Object, noDocument As Object
Dim vaRecipient As Variant
Dim rnBody As Range
Dim Data As DataObject
Const stSubject As String = "TEST"
Const stMsg As String = "TEST"
Const stPrompt As String = "Please select the range:"
lastrow = Range("N" & Rows.Count).End(xlUp).row
For Each Cell In Range("N8:N" & lastrow)
If WorksheetFunction.CountIf(Range("N8:N" & Cell.row), Cell) = 1 Then
If Cells(Cell.row, 11) = "AUTOEMAIL" Then
rnBody = "Hello" & vbNewLine & vbNewLine & _
ActiveCell.EntireRow.Select
On Error Resume Next
'The user canceled the operation.
If rnBody Is Nothing Then Exit Sub
On Error GoTo 0
'Instantiate Lotus Notes COM's objects.
Set noSession = CreateObject("Notes.NotesSession")
Set noDatabase = noSession.GETDATABASE("", "")
'Make sure Lotus Notes is open and available.
If noDatabase.IsOpen = False Then noDatabase.OPENMAIL
'Create the document for the e-mail.
Set noDocument = noDatabase.CreateDocument
'Copy the selected range into memory.
rnBody.Copy
'Retrieve the data from then copied range.
Set Data = New DataObject
Data.GetFromClipboard
'Add data to the mainproperties of the e-mail's document.
With noDocument
.Form = "Memo"
.SendTo = vaRecipient
.Subject = stSubject
'Retrieve the data from the clipboard.
.Body = stMsg & " " & Data.GetText
.SaveMessageOnSend = True
End With
' SEND EMAIL
With noDocument
.PostedDate = Now()
.Send 0, vaRecipient
End With
' REMOVE FROM MEMORY
Set noDocument = Nothing
Set noDatabase = Nothing
Set noSession = Nothing
'SWITCH BACK TO EXCEL
AppActivate "Microsoft Excel"
'EMPTY COPY-PAST CLIPBOARD
Application.CutCopyMode = False
' DISPLAYS TO USER IF SUCCESSFUL
MsgBox "Complete!", vbInformation
End If
End If
Next Cell
End Sub
I set the email body range as a Prompt Box where the user could highlight the cells and then another prompt box in which it asked for the email that was created using a TRIM() function. I realized that the way the code was set-up would not allow for what I wanted to do. The new method works quite well
Treevar
I have 10 columns of data with a varying number of rows which is emailed as an unformatted range. I want to be able to right pad the cells in each column with spaces so the unformatted range copies over as evenly spaced. The reason the range is unformatted is I am using LotusNotes and I don't have the integration options like I have with Outlook. Is there anyway without adding columns that I can pad the cells with a space character so the range looks good in an email?
EDIT: So this allows me to type in an email via an input box and select a range. It will create the email and send but it dosen't preserve the cell formatting (i.e spacing) Can this be done? I have tried using the MIME entities to use HTML however I'm not sure how I'd copy the range into the HTML body
Updated Code:
Sub Lotus_Email()
Dim noSession As Object, noDatabase As Object, noDocument As Object
Dim vaRecipient As String
Dim rnBody As Range
Dim Data As DataObject
Const stSubject As String = "EMAIL SUBJECT"
Const stMsg As String = "Please review the following Purchase Orders and advise."
Const stPrompt As String = "Please select the range:"
'This is one technique to send an e-mail to many recipients but for larger
'number of recipients it's more convenient to read the recipient-list from
'a range in the workbook.
vaRecipient = InputBox("Please enter an e-mail address", "E-Mail Address Entry")
On Error Resume Next
Set rnBody = Application.InputBox(Prompt:=stPrompt, _
Default:=Selection.Address, Type:=8)
'The user canceled the operation.
If rnBody Is Nothing Then Exit Sub
On Error GoTo 0
'Instantiate Lotus Notes COM's objects.
Set noSession = CreateObject("Notes.NotesSession")
Set noDatabase = noSession.GETDATABASE("", "")
'Make sure Lotus Notes is open and available.
If noDatabase.IsOpen = False Then noDatabase.OPENMAIL
'Create the document for the e-mail.
Set noDocument = noDatabase.CreateDocument
'Copy the selected range into memory.
rnBody.Copy
Set rtItem = noDocument.CreateRichTextItem("Body")
With rtItem
.appendtext ("LINE 1")
.addnewline (2)
.appendtext ("LINE 2")
.addnewline (2)
.addnewline (1)
.appendtext ("Please review and respond to the email noted above")
.appendtext ("TEST")
rnBody.PasteSpecial
End With
'Add data to the mainproperties of the e-mail's document.
With noDocument
.Form = "Memo"
.SendTo = vaRecipient
.Subject = stSubject
'Retrieve the data from the clipboard.
' NON-HTML BODY OFF
' .Body = stMsg & vbCrLf & vbCrLf & vbCrLf & vbCrLf & Data.GetText
.SaveMessageOnSend = True
End With
'Send the e-mail.
With noDocument
.PostedDate = Now()
.Send 0, vaRecipient
End With
'Release objects from memory.
Set noDocument = Nothing
Set noDatabase = Nothing
Set noSession = Nothing
'Activate Excel for the user.
AppActivate "Microsoft Excel"
'Empty the clipboard.
Application.CutCopyMode = False
MsgBox "The e-mail has successfully been created and distributed.", vbInformation
End Sub
UNTESTED. Maybe something like this?:
=A1&REPT(" ",25-LEN(A1))
So after using LotusNotes MIME I could import Rich Text, however it wouldn't preserve column width and excel formatting. I created a temp workbook with my range selection and attached it as an attachment. This seems to be the way to handle this with LotusNotes.