Opening outlook 2010 through vbscript - 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

Related

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

How to send a Confidential email using 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

CDO.message vbscript - transport failed to connect

I have a vbscript on a Windows 7 machine in a branch office. It works just fine. I copied the code to a second branch office Windows 7 machine and I get an error. I'm out of ideas.
Both Windows machines have MS Outlook installed.
Do While asObj.ConnectionState = asCONN_CONNECTED
WeekDayNumber = Weekday(Now())
HourNumber = Hour(Now())
'WScript.Echo asObj.HasData
If asObj.HasData Then
WScript.Echo asObj.ReceiveString
WriteData asObj.ReceiveString
uploadData
CycleDate = Now()
asObj.Sleep 300
Else
If WeekDayNumber > 1 And WeekDayNumber < 7 And HourNumber > 8 And HourNumber < 17 Then
DiffInMinutes = DateDiff("n",CycleDate,Now())
'WScript.Echo "Day=" & WeekDayNumber & vbCrLf & "Hour=" & HourNumber & vbCrLf & "cycle=" & CycleDate & vbCrLf & "diff=" & DiffInMinutes & vbCrLf & " Now=" & Now()
If DiffInMinutes > 2 Then
SendAlertEmail
WriteData "Alert email sent " & Now() & vbCrLf
WScript.Echo cyclecounter & " no data"
CycleDate = Now()
' Sleep 5 minutes
asObj.Sleep 1000
End If
End If
End If
Loop
' And finally, disconnect
WScript.Echo "Disconnect -- we should never get to this point. Call Chris!"
asObj.Disconnect
Else
WScript.Echo "bad connection. You have to restart the script"
End If
Sub WriteData(sData)
Const ForAppending = 8
Const OutputFile = "d:\calldata\calldata_data\CallData_$DATE$mtp.txt"
Dim DateNow
Dim varDate
Dim objFile
Dim objFSO
' WScript.Echo sData
Datenow = Date()
varDate = Year(DateNow) & Right("0" & Month(DateNow), 2) & Right("0" & Day(DateNow), 2)
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile(Replace(OutputFile, "$DATE$", varDate), ForAppending, True)
objFile.WriteLine sData
objFile.Close
Set objFile = Nothing
Set objFSO = Nothing
End Sub
Sub uploadData
Dim objShell
Set objShell = Wscript.CreateObject("WScript.Shell")
objShell.Run "c:\calldata\FTPupload.vbs",10,True
objShell.Run "c:\calldata\updateCallData.vbs",10,True
' Using Set is mandatory
Set objShell = Nothing
End Sub
Sub SendAlertEmail
Set email = CreateObject("CDO.Message")
WScript.Echo "step 1"
email.Subject = "MTP - Possible phone time collection failure"
email.From = "x#gmail.com"
email.To = "x#x.com;x#x.com;x#x.com"
email.TextBody = Now() & " The collection of phone time that is done on the MTP Domain Controller seems to have failed. There has been no data for quite a while."
email.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1 'basic (clear-text) authentication
email.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "x#gmail.com"
email.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "password"
email.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing")=2
email.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver")="smtp.gmail.com"
email.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport")=25
email.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = 1
email.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 30
email.Configuration.Fields.Update
email.Send
If Err Then
WScript.Echo "SendMail Failed:" & Err.Description
End If
set email = Nothing
'WScript.Echo"step 2"
End Sub
Gmail is on 465 and not enough is specified.
Here's working code
Set emailObj = CreateObject("CDO.Message")
emailObj.From = "d#gmail.com"
emailObj.To = "d#gmail.com"
emailObj.Subject = "Test CDO"
emailObj.TextBody = "Test CDO"
emailObj.AddAttachment "c:\windows\win.ini"
Set emailConfig = emailObj.Configuration
emailConfig.Fields("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"
emailConfig.Fields("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465
emailConfig.Fields("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
emailConfig.Fields("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
emailConfig.Fields("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = true
emailConfig.Fields("http://schemas.microsoft.com/cdo/configuration/sendusername") = "d"
emailConfig.Fields("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "Password1"
emailConfig.Fields.Update
emailObj.Send
If err.number = 0 then Msgbox "Done"
I have received this error before, and for me it was the security rights between one computer and another. it will be worth checking the access rights on the two machines and see if there are differences.

Internal Server Error with VB script

I'm trying to send an email with VB script/ASP (I don't normally use this language but this is what the site is built in), and it is throwing a 500 error.
I'm not seeing what I did wrong. Everything looks like it should execute to me. Any ideas?
<%
dim name
dim from
dim company
dim phone
dim zip
dim message
dim areas
name = Request.Form("name")
from = Request.Form("from")
company = Request.Form("company")
phone = Request.Form("phone")
zip = Request.Form("zip")
areas = Request.Form("areas")
message = Request.Form("message")
Dim Mail, strHost
Dim strSubject, strBody, strPath
strHost = "localhost"
Set Mail = Server.CreateObject("Persits.MailSender")
Mail.Host = strHost
Mail.From = "cphelps#client.com"
Mail.FromName = "Client Name"
Mail.AddAddress "cphelps#client.com"
If Not InStr(from, "domain.com") Then Mail.AddBcc "cphelps#client.com"
Mail.Subject = name & " sent a request"
Mail.Body = name & "," & vbCrLf & vbCrLf &_
"Name:" & name & vbCrLf &_
"Company: " & company & vbCrLf &_
"From: " & from & vbCrLf &_
"Phone: " & phone & vbCrLf &_
"Zip Code: " & zip & vbCrLf &_
"Message: " & message & vbCrLf &_
Mail.Send
Response.Redirect("jlg_thank_you.asp")
set Mail = nothing
%>
The first thing I noticed is that you are missing an End If in the code sample provided.
I disabled Friendly error messages and I attempted to run the code and got this error:
Server object error 'ASP 0177 : 800401f3'
Server.CreateObject Failed
/test.asp, line 26
800401f3
On researching this error I found someone with a similar problem:
Server.createObject with Persist.Mailsender error
They suggested that its a missing dll problem.
For my projects I have used Server.CreateObject("CDO.Message")
Here is an example of my code:
Set mail = Server.CreateObject("CDO.Message")
mail.To = varTo
mail.From = varFrom
mail.Subject = varSubject
mail.HTMLBody = varBody
mail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing")=2
mail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver")="smtp.domain.com"
mail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport")=25
mail.Configuration.Fields.Update
mail.Send
Make sure you downloaded the latest version of ASPEmail and that it is present on the server running the script.
Also, register it using this command line:
regsvr32 c:\path\aspemail.dll

CDONTS in Loop Issue 2008 server

I have the following CDONTS code that works fine:
Dim CDONTSMail
Set CDONTSMail = CreateObject("CDONTS.NewMail")
CDONTSMail.From= "me#gmail.com"
CDONTSMail.To= "me#gmail.com"
CDONTSMail.Subject= "500.100 Error: " & objASPError.File
strBody = "This is a test message." & vbCrLf
CDONTSMail.Body= sErrorMes
CDONTSMail.Send
set CDONTSMail=nothing
However the following when used in a loop errors out? any ideas?
'Create Mailer object and send message
CDONTSMail.From= "me#gmail.com"
CDONTSMail.To = Session("Email")
CDONTSMail.Subject = Subject
strBody = MainMessage & vbCrLf
CDONTSMail.Body= strBody
CDONTSMail.Send
You need to set CDONTSMail again.
Try this in your loop:
Set CDONTSMail = CreateObject("CDONTS.NewMail")
CDONTSMail.From= "me#gmail.com"
CDONTSMail.To= "me#gmail.com"
CDONTSMail.Subject = Subject
strBody = MainMessage & vbCrLf
CDONTSMail.Body= strBody
CDONTSMail.Send
set CDONTSMail=nothing

Resources