How to send a Confidential email using VBScript - vbscript

I have been searching on-line on how to send an email with attachment as confidential. I was already able to create a script to be able to send an email with an attachment but I can't figure out how to send it as confidential.
I would appreciate if somebody can help me how to set email sensitivity in VBScript.
Here's my code:
Call Email
sub Email
Set objEmail = CreateObject("CDO.Message")
Set objFSO = CreateObject("Scripting.FileSystemObject")
objEmail.From = "myemail"
objEmail.To = "SendToEmail"
ObjEmail.Subject = "Email Title"
ObjEmail.Textbody = "Email Body"
objEmail.AddAttachment "C:\Temp\ERSD\dchmar_" & sDate & ".txt"
objEmail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
objEmail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") ="xx.xx.xx.xx"
objEmail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
objEmail.Configuration.Fields.Item("http://schemas.microsoft.com/exchange/sensitivity") = 3
objEmail.Configuration.Fields.Update
objEmail.Send
End sub

Could you try this?
It's unknown if you have some custom headers. So check the headers in Outlook to see if those match with what I've posted below but I believe that should accomplish what you're asking.
Set objEmail = CreateObject("CDO.Message")
Set objEmailConf = CreateObject("CDO.Configuration")
Set objFSO = CreateObject("Scripting.FileSystemObject")
objEmail.From = "myemail"
objEmail.To = "SendToEmail"
ObjEmail.Subject = "Email Title"
ObjEmail.Textbody = "Email Body"
objEmail.AddAttachment "C:\Temp\ERSD\dchmar_" & sDate & ".txt"
objEmailConf.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
objEmailConf.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") ="xx.xx.xx.xx"
objEmailConf.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
'objEmailConf.Fields.Item("http://schemas.microsoft.com/exchange/sensitivity") = 3
objEmailConf.Fields.Update
objEmail.Configuration.Fields.Item("urn:schemas:mailheader:Sensitivity") = "Company-Confidential"
objEmail.Configuration.Fields.Update
objEmail.Send

Related

How to send an email with multiple attachments

This code is working well as long as every file is there.
What is missing in the code for sending an email even if a file is missing?
I have tried to find a solution but without success.
Set fso=CreateObject("Scripting.FileSystemObject")
strSMTP="smtp.telenor.no"
strSubject="Files form me to you"
strSubject="XXXXX"
strSubject="XXXX"
strBody="XXXXXX"
strAttach="File 1.csv"
strAttach1="File 2.csv"
strAttach2="File 3.csv"
If fso.FileExists(strAttach) then
Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")
iConf.Load -1 ' CDO Source Defaults
Set Flds = iConf.Fields
With Flds
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = strSMTP
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
.Update
End With
With iMsg
Set .Configuration = iConf
.To = "XXXX"
.CC = ""
.BCC = ""
.From = "XXXX"
.Subject = strSubject
.TextBody = strBody
.AddAttachment strAttach
.AddAttachment strAttach1
.AddAttachment strAttach2
.Send
End With
Set iMsg = Nothing
Set iConf = Nothing
Else
MsgBox "The specified attachment does not exist"
End if
The following uses an ArrayList to hold your attachments and adds them to the message one by one, checking if the file exists first:
Dim iCounter
Dim sAttachment
Dim objAttachments
Set objAttachments = CreateObject("System.Collections.ArrayList")
objAttachments.Add "File 1.csv"
objAttachments.Add "File 2.csv"
objAttachments.Add "File 3.csv"
Set objFSO = CreateObject("Scripting.FileSystemObject")
strSMTP = "smtp.telenor.no"
strSubject = "Files form me to you"
strSubject = "XXXXX"
strSubject = "XXXX"
strBody = "XXXXXX"
' Create message and configuration
Set objMessage = CreateObject("CDO.Message")
Set objConf = CreateObject("CDO.Configuration")
objConf.Load -1 ' CDO Source Defaults
Set objFields = objConf.Fields
With objFields
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = strSMTP
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
.Update
End With
' Initalize message
With objMessage
Set .Configuration = objConf
.To = "XXXX"
.CC = ""
.BCC = ""
.From = "XXXX"
.Subject = strSubject
.TextBody = strBody
End With
' Add attachments
For iCounter = 1 To objAttachments.Count
sAttachment = objAttachments.Item(iCounter - 1)
If objFSO.FileExists(sAttachment) Then objMessage.AddAttachment sAttachment
Next
' Send Message
objMessage.Send

Send email attachment

I'm new to vbs script but in this code I cant get the attachment to be sent. it sends the email but no attachment
Can anyone help
DIM fso
Set fso=CreateObject("Scripting.FilesystemObject")
On Error Resume Next
fso.CopyFile "C:\ASoft32\*.*", "E:\ASoft32\"
'Wscript.Echo "File copy complete."
strSMTPFrom = "jbmotors#hotmail.com"
strSMTPTo = "iain#252.co.uk"
strSMTPRelay = "smtp.live.com"
strTextBody = "Backup done vbs"
strSubject = "VBS ALERT"
strAddAttachment "(C:\ASoft32\Hamer.ftm)"
Set oMessage = CreateObject("CDO.Message")
oMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
oMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = strSMTPRelay
oMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
oMessage.Configuration.Fields.Update
oMessage.Subject = strSubject
oMessage.From = strSMTPFrom
oMessage.To = strSMTPTo
oMessage.TextBody = strTextBody
oMessage.AddAttachment strADDAttachment
oMessage.Send
'Wscript.Echo "Email sent."
Const TIMEOUT = 2
Set objShell = WScript.CreateObject("WScript.Shell")
objShell.Popup "Email sent" , TIMEOUT
strAddAttachment "(C:\ASoft32\Hamer.ftm)" in your code won't work.
Try:
strAddAttachment = "C:\ASoft32\Hamer.ftm"
Assuming that the file exists in this location, that should work.

Attaching workbook to email

I have the below code and it will open the email with the relevant details however the workbook is not attaching itself - cannot see why (being a newbie!)
Also is there a way of attaching a signature to the email? I'm using the newest version of the MS applications so not sure if this has any issues
Sub Email_workbook()
Dim OutApp As Object
Dim OutMail As Object
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.to = "pknight#xxxx.com"
.CC = ""
.BCC = ""
.Subject = "Daily UK Orders Report"
.Body = "Good afternoon, " & vbNewLine & vbNewLine & _
"Please see the attached report for today's UK orders" & vbNewLine & _
"Kind regards"
.Attachments.Add ActiveWorkbook.Daily_UK_Orders_Report.xlsm
.display
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
Thanks for your help
Phill

Giving an attachment a name when sending it with VBscript

set cdoConfig = CreateObject("CDO.Configuration")
with cdoConfig.Fields
.Item(cdoSendUsingMethod) = cdoSendUsingPort
.Item(cdoSMTPServer) = "localhost"
.Item(cdoSMTPAuthenticate) = 1
.Item(cdoSendUsername) = "contact#example.com"
.Item(cdoSendPassword) = "password"
.Update
end with
set cdoMessage = CreateObject("CDO.Message")
with cdomessage
set .Configuration = cdoConfig
.From = "contact#example.com"
.To = email
.Subject = subject
.HTMLBody = message
.AddAttachment "c:/i/report.pdf"
.Send
end with
set cdomessage = nothing
set cdoconfig = nothing
Everything sends find, but the recipient gets the message as "Untitled Attachment 000X.pdf"
How do I give the attachment a name?
I have something like this. But never tried.
'With cdomessage
.AddAttachment "c:/i/report.pdf"
.Attachments(1).Fields.Item("urn:schemas:mailheader:content-disposition") ="attachment;filename=" & NEWNAME
.Attachments(1).Fields.Update
'End With

Opening outlook 2010 through vbscript

I want to send email using outlook 2010, windows 7 & IE8 , what is code required to get the "Outlook.Application" object?.
I tried with
CreateObject("Outlook.Application") but getting error "Object Required"
Sample Code :-
' Create email object
Set oolApp = CreateObject("Outlook.Application")
Set email = oolApp.CreateItem(0)
email.Recipients.Add("abcaashn#gmail.com")
' Create the body of the email
MailBody = "<!DOCTYPE HTML PUBLIC ""-//W3C//DTD W3 HTML//EN"">"
MailBody = MailBody & "<HTML>" & vbcrlf
MailBody = MailBody & "<HEAD><TITLE>No Invoices</TITLE></HEAD>"
MailBody = MailBody & "<BODY>" & vbcrlf
MailBody = MailBody & "<B>For Your Information</B>,<BR><BR>"
MailBody = MailBody & "This is Sample Email.<BR><BR>"
MailBody = MailBody & "</BODY></HTML>"
' Send the Email
email.Subject = "No Invoices Issued"
email.HTMLBody = MailBody
email.Send
Try This simple code.
This will help you till opening the Outlook and navigate you to Inbox
Set objOutlook = CreateObject("Outlook.Application")
Set objNamespace = objOutlook.GetNamespace("MAPI")
objNamespace.Logon "Default Outlook Profile", , False, True
Set objFolder = objNamespace.GetDefaultFolder(olFolderInbox)
objFolder.Display
End Sub
You can send an email using CDO which is the subsystem that Outlook uses. You can find more information in my article Sending Emails Using CDO in WSH on ASP Free.
Set objMessage = CreateObject("CDO.Message")
' Set Email Headers
objMessage.From = "sender#mymail.com"
objMessage.To = "abcaashn#gmail.com"
objMessage.Subject = "No Invoices Issued"
' Construct Email Body
objMessage.HTMLbody = "<b>For Your Information</b>, <br><br>" _
& "This is a Sample Email.<br><br>"
objMessage.AutoGenerateTextBody = True
' Set Server Settings
objEmail.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
objEmail.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.mymail.com"
objEmail.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
objEmail.Configuration.Fields.Update
objEmail.Send
This will work for me:-
Public Sub runOutlook
Set oolApp = CreateObject("Outlook.Application")
Set objNS = oolApp.GetNamespace("MAPI")
Set email = oolApp.CreateItem(0)
email.Display
email.To = "yash.tiwari#programmers.io"
email.Subject = "Test"
email.HTMLbody = "<b>For Your Information</b>, <br><br>" _
& "This is a Sample Email.<br><br>"
email.GetInspector.WindowState = 2
End Sub

Resources