VBA code for using text from TextBox Control in email - vba

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

Related

copy paragraph from multiline texbox form to outlook

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.

Code to email one page from word using submit button

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

email and signature formatting using Excel VBA

I have written the macros I need and Im stuck on a "simple matter". Email formatting as well as signature formatting. The signature is in plain text, but in outlook its formatted using different text color and font.
I have the following code which gives me the email in the following format:
email TITUS classification
Body of the email
Signature
Attachment
The code
Sub mail()
Dim wkb As Excel.Workbook
Dim wks As Excel.Worksheet
Set wkb = Excel.Workbooks("macro.xlsm")
Set wks = wkb.Worksheets("settings")
Dim OApp As Object, OMail As Object, signature As String
Dim OStrTITUS As String
Set OApp = CreateObject("Outlook.Application")
Set OMail = OApp.CreateItem(0)
With OMail
.display
signature = OMail.body
.To = "mymail#mail.com"
.Subject = "Type your email subject here"
.Attachments.Add ActiveWorkbook.FullName
.body = "My email body" & vbNewLine & signature
.display
SendKeys "{DOWN}{DOWN}{ENTER}", True 'set classification
SendKeys "{ENTER}", True 'send to group
.Send
End With
Set OMail = Nothing
Set OApp = Nothing
End Sub
But I would like for the attachment in outlook to be in the body of the email, so the layout would be something like this
Body of the email
Attachment
Signature
You could try format as follows modified from code by #Niton
Sub mail()
Dim wkb As Excel.Workbook
Dim wks As Excel.Worksheet
Set wkb = Excel.Workbooks("macro.xlsm")
Set wks = wkb.Worksheets("settings")
Dim OApp As Object, OMail As Object, signature As String
Dim OStrTITUS As String
Set OApp = CreateObject("Outlook.Application")
Set OMail = OApp.CreateItem(0)
With OMail
.Display
signature = OMail.body
.To = "mymail#mail.com"
.Subject = "Type your email subject here"
.Display
.body = "My email body" & vbNewLine & signature
If .BodyFormat <> olFormatRichText Then .BodyFormat = olFormatRichText
.Attachments.Add wkb.FullName, 999
SendKeys "{DOWN}{DOWN}{ENTER}", True 'set classification
SendKeys "{ENTER}", True 'send to group
.Send
End With
Set OMail = Nothing
Set OApp = Nothing
End Sub

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