Code to email one page from word using submit button - vba

I would like to send the last page of a word document (162 pages long) using email. Currently I can send the whole document, but would like the last page that has the submit button to be the only thing sent.
I have tried changing the name to pge etc. I have little experience.
Private Sub CommandButton1_Click()
Dim OL As Object
Dim EmailItem As Object
Dim Doc As Document
Application.ScreenUpdating = False
Set OL = CreateObject("Outlook.Application")
Set EmailItem = OL.CreateItem(olMailItem)
Set Doc = ActiveDocument
Doc.Save
With EmailItem
.Subject = "Insert Subject Here"
.Body = "I just want this to work already!!"
.To = "fakeemail#Idonotknowcode.ca"
.Importance = olImportanceNormal 'Or olImprotanceHigh Or olImprotanceLow
.Attachments.Add Doc.FullName
.Send
End With
Application.ScreenUpdating = True
Set Doc = Nothing
Set OL = Nothing
Set EmailItem = Nothing
End Sub

Related

VBA code for using text from TextBox Control in email

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

Outlook Appointment isn't showing Attendees that have been added

I'm having some problems with some pieces of code that I've Frankenstein'd from the web. I have a Word document that uses a command button to run a piece of code, the end result being an Outlook Appointment being generated with a template added, as well as recipients. I've used 2 different methods, and they each present their own problem.
Method 1: Generates the Appointment, includes and displays the attendees, but does not allow for HTML formatting of the body
Dim xOutlookObj As Object
Dim OMail As Object
Dim xMeeting As Object
Dim xDoc As Object
Dim myRequiredAttendee As Outlook.Recipient
Dim myOptionalAttendee As Outlook.Recipient
Application.ScreenUpdating = False
Set xOutlookObj = CreateObject("Outlook.Application")
Set xEmail = xOutlookObj.CreateItem(olMailItem)
Set xDoc = ActiveDocument
opCancel = False
Set xOutlookObj = CreateObject("Outlook.Application")
Set xMeeting = xOutlookObj.CreateItem(olAppointmentItem)
Set myRequiredAttendee = xMeeting.Recipients.Add(EMAIL ADDRESSES)
myRequiredAttendee.Type = olRequired
Set xDoc = ActiveDocument
With xMeeting
.MeetingStatus = olMeeting
.Display
.Subject = "MEETING SUBJECT"
.Duration = 60
.Body = "MESSAGE BODY THAT I'D LIKE TO FORMAT, BUT THIS METHOD DOESN'T PERMIT HTML"
End With
Set xDoc = Nothing
Set xMeeting = Nothing
Set xOutlookObj = Nothing
Application.ScreenUpdating = True
Method 2: Generates the Appointment, allows for HTML formatting of the body, loads the attendees but does not display them. When I click the 'Invite Attendee' button in the invite, they all appear (so they're obviously being loaded).
Dim olapp As Outlook.Application, appt As Outlook.AppointmentItem
Dim m As Outlook.MailItem
Dim rtf() As Byte
Set olapp = New Outlook.Application
Set m = olapp.CreateItem(olMailItem)
Set appt = olapp.CreateItem(olAppointmentItem)
appt.Display
appt.Subject = "MEETING SUBJECT"
appt.Duration = 60
appt.RequiredAttendees = "EMAIL ADDRESSES"
m.BodyFormat = olFormatHTML
m.HTMLBody = "<font style=""color: red;"">VERIFY SUBJECT LINE & MEETING START TIME ARE CORRECT, THEN DELETE THIS LINE" & _
"<font style=""color: black;""><p>REST OF TEXT BODY</P>
m.GetInspector().WordEditor.Range.FormattedText.Copy
appt.GetInspector().WordEditor.Range.FormattedText.Paste
m.Close False 'don't save...
What I'm looking for is code that creates the Appointment, loads and displays the attendees, and allows HTML formatting of the body. Also, I can't use the .send command because the body of the invite still needs to be edited before it's sent - which is why I'd like the attendees to be displayed to avoid confusion.
Thanks!
#1 is fine, but AppointmentItem object does not directly support HTML - you get either plain text Body property or RTF formatted (array of byte) RtfBody property. You needed to either generate the appropriate RTF, or use AppointmentItem.GetInspector().WordEditor (returns Word's Document object) to produce the suitably formatted body.
The following code generates the appointment, loads the recipients and displays them, as well as formats the message body in HTML.
Dim xOutlookObj As Object
Dim OMail As Object
Dim xMeeting As Object
Dim xDoc As Object
Dim myRequiredAttendee As Outlook.Recipient
Dim myOptionalAttendee As Outlook.Recipient
Application.ScreenUpdating = False
Set xOutlookObj = CreateObject("Outlook.Application")
Set xEmail = xOutlookObj.CreateItem(olMailItem)
Set xDoc = ActiveDocument
Set xOutlookObj = CreateObject("Outlook.Application")
Set xMeeting = xOutlookObj.CreateItem(olAppointmentItem)
Set myRequiredAttendee = xMeeting.Recipients.Add(EMAIL LIST)
myRequiredAttendee.Type = olRequired
Set xDoc = ActiveDocument
With xMeeting
.MeetingStatus = olMeeting
.Display
.Subject = "MEETING SUBJECT"
.Duration = 60
'**
xEmail.BodyFormat = olFormatHTML
xEmail.HTMLBody = "<font style=""color: red;"">VERIFY SUBJECT LINE & MEETING START TIME ARE CORRECT, THEN DELETE THIS LINE" & _
"<font style=""color: black;""><p>THE REST OF APPT MESSAGE</p>"
xEmail.GetInspector().WordEditor.Range.FormattedText.Copy
xMeeting.GetInspector().WordEditor.Range.FormattedText.Paste
'**
End With
Set xDoc = Nothing
Set xMeeting = Nothing
Set xOutlookObj = Nothing
Application.ScreenUpdating = True
The ** part is what I changed to make this work.

Powerpoint email form with click

Hello I'm trying to build a VBA code to automatically send a copy of a completed form once the form has been completed. I have this form currently and I was able to write the following code for a word document:
Private Sub CommandButton1_Click()
Dim OL As Object
Dim EmailItem As Object
Dim Doc As Document
Application.ScreenUpdating = False
Set OL = CreateObject("Outlook.Application")
Set EmailItem = OL.CreateItem(olMailItem)
Set Doc = ActiveDocument
Doc.Save
With EmailItem
.Subject = "SUBJECT LINE"
.Body = "BODY MESSAGE" & vbCrLf & _
"SECOND LINE BODY MESSAGE" & vbCrLf & _
"THIRD LINE BODY MESSAGE"
.To = "Receiver Email"
.Importance = olImportanceNormal
.Attachments.Add Doc.FullName
.Send
End With
Application.ScreenUpdating = True
Set Doc = Nothing
Set OL = Nothing
Set EmailItem = Nothing
End Sub
this worked fine with the word document, but now I have to do the following in powerpoint. I tried to use the following code below, but everytime I run this I get a compile error: Method or data member not found. Does anyone know why the below code doesn't work?
Private Sub CommandButton1_Click()
Dim OL As Object
Dim EmailItem As Object
Dim Powerpoint As Presentation
Application.ScreenUpdating = False
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 = "NAME#COMPANY.COM"
.Importance = olImportanceNormal
.Attachments.Add Doc.FullName
.Send
End With
Application.ScreenUpdating = True
Set Doc = Nothing
Set OL = Nothing
Set EmailItem = Nothing
End Sub
Any help would be appreciated thanks!
It seems you are still using the Doc variable, when the name of the new variable for the presentation is Powerpoint. Take a look at the following lines:
Doc.Save
.Attachments.Add Doc.FullName
Set Doc = Nothing
Replace Doc with Powerpoint and your code should work.

Save a file with Names

I have a form in word, whenever a submit is clicked upon it send a notification to email address and saves the file to a location. I have a script as below, I want when the data is input in the form and clicked on submit for 2nd time the saved file should have a different name because if the below script is run again it will overwrite the current form which is saved on that location.
Private Sub CommandButton1_Click()
Dim OL As Object
Dim EmailItem As Object
Dim Doc As Document
Application.ScreenUpdating = False
Set OL = CreateObject("Outlook.Application")
Set EmailItem = OL.CreateItem(olMailItem)
Set Doc = ActiveDocument
Doc.Save
Doc.SaveAs2 "d:/abcd.docx"
With EmailItem
.Subject = "Test"
.Body = "Test"
.To = "jaiswalrohitkr#gmail.com"
.Importance = olImportanceNormal 'Or olImprotanceHigh Or olImprotanceLow
.Attachments.Add Doc.FullName
.Send
End With
Application.ScreenUpdating = True
Set Doc = Nothing
Set OL = Nothing
Set EmailItem = Nothing
End Sub
You can use a global counter and the FileSystemObject to accomplish this.
'Global Variable to hold our iteration count
Public docCount As Integer
Private Sub CommandButton1_Click()
Dim OL As Object
Dim EmailItem As Object
Dim Doc As Document
Dim DocName As String
'add a reference to Microsoft Scripting Runtime
Dim fso As FileSystemObject
Set fso = New FileSystemObject
Application.ScreenUpdating = False
Set OL = CreateObject("Outlook.Application")
Set EmailItem = OL.CreateItem(olMailItem)
Set Doc = ActiveDocument
Doc.Save
DocName = "d:/abcd.docx"
'use the fileSystemObject to check if the file already exists
Do While fso.FileExists(DocName) = True
DocName = "d:/abcd" & CStr(docCount) & ".docx"
'add one to the counter to check again
docCount = docCount + 1
Loop
Doc.SaveAs2 DocName
With EmailItem
If docCount > 0 Then
'more than one iteration so adjust name
.Subject = "Test" & CStr(docCount)
Else
'first iteration so leave it as test
.Subject = "Test"
End If
.Body = "Test"
.To = "jaiswalrohitkr#gmail.com"
.Importance = olImportanceNormal 'Or olImprotanceHigh Or olImprotanceLow
.Attachments.Add Doc.FullName
.Send
End With
Application.ScreenUpdating = True
Set Doc = Nothing
Set OL = Nothing
Set EmailItem = Nothing
End Sub

Code for clearing form fields after emailing filled-out form

I have created a 2010 Word doc with form fields and a command button to email the form. I did find code to close the doc after the email sent but, I need it to not save the changes before it closes the doc or clears the fields and uncheck the check boxes before it closes.
The goal is that they open a fresh form every time.
They are a contract company as well so I'm sending the form for them to save to their own drive, other wise I would have saved to our templates.
Private Sub CommandButton1_Click()
Dim OL As Object
Dim EmailItem As Object
Dim Doc As Document
Application.ScreenUpdating = False
Set OL = CreateObject("Outlook.Application")
Set EmailItem = OL.CreateItem(olMailItem)
Set Doc = ActiveDocument
Doc.Save
With EmailItem
.Subject = "Medical/Psych router"
.To = "test#email.com"
.Importance = olImportanceNormal
.Attachments.Add Doc.FullName
.Send
End With
Application.ScreenUpdating = True
Set Doc = Nothing
Set OL = Nothing
Set EmailItem = Nothing
Application.ActiveDocument.Close
End Sub
Try saving it to Temp Folder C:\Temp\, The Master Doc will be blank and you will have new file saved at C\Temp\ with file name Medical_Psych_router today's date Jun_18_2015. (Medical_Psych_router Jun_18_2015)
Option Explicit
Private Sub CommandButton1_Click()
Dim OL As Object
Dim EmailItem As Object
Dim Doc As Document
Dim sFileName As String
Application.ScreenUpdating = False
Set OL = CreateObject("Outlook.Application")
Set EmailItem = OL.CreateItem(olMailItem)
Set Doc = ActiveDocument
sFileName = "Medical_Psych_router " & Format(Now, "mmm_dd_yyyy")
Doc.SaveAs FileName:=("C:\Temp\") & sFileName, _
FileFormat:=wdFormatDocument, _
AddToRecentFiles:=True
'Doc.Save
With EmailItem
.Subject = "Medical/Psych router"
.To = "test#email.com"
.Importance = olImportanceNormal
.Attachments.Add Doc.FullName
.Send
End With
Application.ScreenUpdating = True
Set Doc = Nothing
Set OL = Nothing
Set EmailItem = Nothing
Application.ActiveDocument.Close SaveChanges:=False
End Sub