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
Related
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
Apologies in advance for any incorrect terminology (I am a PC Tech, not a developer/programmer).
We have a VBScript running in one of our servers to send an email notice to users that their Windows password will expire and they need to change it. The script is as follows:
*******************Begin Code*****
on error resume next
Const ADS_UF_DONT_EXPIRE_PASSWD = &h10000
Const E_ADS_PROPERTY_NOT_FOUND = &h8000500D
Const ONE_HUNDRED_NANOSECOND = .000000100
Const SECONDS_IN_DAY = 86400
strDomainDN = "DomainNameHere" 'Domain name here - both Netbios and DNS style names should work
ReminderAge = 10 'Days before the reminders start being sent
'strbody - Body of the message being sent
strbody = "This message is a reminder that your password will be expiring soon." & vbcrlf
strbody = strbody & "Please change your network password before the date listed above to avoid being locked out of the system." & vbcrlf
strbody = strbody & "If you need instructions on how to change your password please contact:" & vbcrlf
strbody = strbody & "the IT Department" & vbcrlf
strbody = strbody & vbcrlf & "Thank you," & vbcrlf
strbody = strbody & "IT Department"
'create logfile
Set objFSO = CreateObject("Scripting.FileSystemObject")
strScriptPath = objfso.GetParentFolderName(WScript.ScriptFullName)
strLogName = TwoDigits(Year(now)) & TwoDigits(Month(now)) & TwoDigits(Day(now)) & TwoDigits(Hour(now)) & TwoDigits(Minute(now)) &
TwoDigits(Second(now)) & ".txt"
strLogFile = strScriptPath & "Logs\" & StrLogName
Set objLogFile = objFSO.CreateTextFile(strLogFile,1)
objLogfile.Writeline "Email Password Check Script started: " & Now
Dim rootDSE,domainObject
Set rootDSE = GetObject("LDAP://RootDSE")
Set oDomain = GetObject("LDAP://" & strDomainDN)
Set maxPwdAge = oDomain.Get("maxPwdAge")
DomainContainer = rootDSE.Get("defaultNamingContext")
Set fs = CreateObject ("Scripting.FileSystemObject")
Set conn = CreateObject("ADODB.Connection")
conn.Provider = "ADSDSOObject"
conn.Open "ADs Provider"
numDays = CCur((maxPwdAge.HighPart * 2 ^ 32) + maxPwdAge.LowPart) / CCur(-864000000000)
'LDAP string to only find user accounts with mailboxes
ldapStr = "<LDAP://" & DomainContainer & ">;(& (mailnickname=*) (|
(&(objectCategory=person)(objectClass=user)(!(homeMDB=*))(!(msExchHomeServerName=*)))(&(objectCategory=person)(objectClass=user)(|(homeMDB=*)(msExchHomeServerName=*))) ));adspath;subtree"
Set rs = conn.Execute(ldapStr)
While Not rs.EOF
Set oUser = GetObject (rs.Fields(0).Value)
dtmValue = oUser.PasswordLastChanged
If Err.Number = E_ADS_PROPERTY_NOT_FOUND Then
whenpasswordexpires = "The password has never been set."
else
whenPasswordExpires = DateAdd("d", numDays, oUser.PasswordLastChanged)
end if
daysb4expire = Int(whenPasswordExpires - Now)
'write user info to logfile
objLogfile.Writeline "-----------------------------------------"
objLogfile.Writeline "SAM Acct: " & oUser.SamAccountName
objLogfile.Writeline "Disp Name: " & oUser.displayName
objLogfile.Writeline "UPN: " & oUser.userprincipalname
objLogfile.Writeline "PW Changed: " & oUser.PasswordLastChanged
objLogfile.Writeline "PW Expires: " & whenPasswordExpires
dblMaxPwdNano = Abs(MaxPwdAge.HighPart * 2^32 + MaxPwdAge.LowPart)
dblMaxPwdSecs = dblMaxPwdNano * ONE_HUNDRED_NANOSECOND
dblMaxPwdDays = Int(dblMaxPwdSecs / SECONDS_IN_DAY)
objLogfile.Writeline "The password will expire on " & _
DateValue(dtmValue + dblMaxPwdDays) & " (" & _
Int((dtmValue + dblMaxPwdDays) - Now) & " days from today)."
if daysb4expire < ReminderAge and daysb4expire > 0 then
objLogfile.Writeline "Expiring soon - sending eMail"
objLogfile.Writeline "*****************************"
strNoteMessage = "Dear " & oUser.displayName & "," & vbcrlf & vbcrlf
strNoteMessage = strNoteMessage & "Your Network password will expire on " & _
DateValue(dtmValue + dblMaxPwdDays) & " (" & _
Int((dtmValue + dblMaxPwdDays) - Now) & " days from today)." & vbcrlf & vbcrlf
Set objEmail = CreateObject("CDO.Message")
objEmail.From = "me#myCompany.com" 'Your From Address
objEmail.To = oUser.userprincipalname
objEmail.Subject = "Network Password Expiration Notice" 'Message subject
objEmail.TextBody = strNoteMessage & strBody
objEmail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
objEmail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") =
"YOUREXCHANGE.SERVER.DomainName.COM" ' Your mailserver here
objEmail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
objEmail.Configuration.Fields.Update
'objEmail.Send 'commented out right now---so you won't send out the email.
End If
set whenpasswordexpires = nothing
err.clear
rs.MoveNext
Wend
Set oUser = Nothing
Set maxPwdAge = Nothing
Set oDomain = Nothing
Logfile.Close
Function TwoDigits(t)
TwoDigits = Right("00" & t,2)
End Function
WScript.quit
Obviously I removed our info from the script for this post.
The errors are that:
It does not send an email everyday if the user does not change their password for a few days. It sends them randomly.
A few random users, if they have not changed their password, around the 5th or 6th day will start getting hundreds of thousands of emails in just a few seconds, completely locking down Outlook on their computer. If they change the password they stop getting them (obviously).
Is there something I'm missing or need to remove from this script to get it to at least stop sending so many emails at once?
Thank you.
A couple of ideas to help you track down the problem.
Only have on error resume next before the command that needs it oUser.PasswordLastChanged, after that line on error goto 0 Then run the script manually and you'll have a better chance of finding some statement that is failing. update - should store the value in a variable and use
Get consistent with what variables are for. whenpasswordexpires is set to text in one part of the if err.number and a date in the other. It's then used as a date to calculate days and finally set whenpasswordexpires = nothing treats it like an object. This could mean some of your if statements are erroring and just going to the next line, instead of skipping the if - so people might be getting mailed when they shouldn't.
Consider calculating a date to pass to the LDAP query and only return people to be emailed - instead of going through all users all the time
(without ever having much to do with LDAP queries) I think your current query simplifies down to ldapStr = "<LDAP://" & DomainContainer & ">;(& (mailnickname=*)(objectCategory=person)(objectClass=user));adspath;subtree" all the ors and ands with homeMDB and msExchHomeServerName would seem to mean any combination is included. It's probably worth running your query in an LDAP explorer tool to check you're really getting what you want.
LDAP often has a limit of the number of records returned, so you might be erroring all the time because you get more than 1000 (typical) records returned. This can be worked around by getting data in smaller pages (say 250).
Logging to a new file each time may hide issues from you, e.g if the task is restarted by scheduler. Much easier to diagnose if there is just one log per day. You also don't close the log file correctly - should be objLogFile.Close (not logfile.Close). You aren't putting the log in a subdirectory of the scripts folder (e.g. scripts & scripts\logs) but at the same level (e.g. scripts & scriptsLogs)
The logfile not objLogFile issue highlights why it is best to put Option Explicit at the top of your code. This means you have to dim every variable that you use, which can be a pain to do, but ensures that you don't have typos in your variable names which can cause you massive headaches.
The WScript.Quit is the very last line, so won't do anything - the codes about to finish anyway. If you ever want to abort the execution of script, the WScript.Quit needs to where you want to abort from - normally within some if statement.
There are a number of repeated calculations... days, dtmValue + dblMaxPwdDays, etc. I just mention this as it makes the code harder to read and therefore harder to understand what might be wrong.
All that said, I've probably made too many comments now for you to really comprehend without me just making the changes and posting updated script for you to try.
See if this version runs error free for you...
option explicit
Const ADS_UF_DONT_EXPIRE_PASSWD = &h10000
Const E_ADS_PROPERTY_NOT_FOUND = &h8000500D
Const ONE_HUNDRED_NANOSECOND = .000000100
Const SECONDS_IN_DAY = 86400
Dim strDomainDN, strBody, strNoteMessage
Dim objFSO, objLogFile, objEmail
Dim strScriptPath, strLogName, strLogFile
strDomainDN = "DomainNameHere" 'Domain name here - both Netbios and DNS style names should work
Const ReminderAge = 10 'Days before the reminders start being sent
'strbody - Body of the message being sent
strbody = "This message is a reminder that your password will be expiring soon." & vbcrlf
strbody = strbody & "Please change your network password before the date listed above to avoid being locked out of the system." & vbcrlf
strbody = strbody & "If you need instructions on how to change your password please contact:" & vbcrlf
strbody = strbody & "the IT Department" & vbcrlf
strbody = strbody & vbcrlf & "Thank you," & vbcrlf
strbody = strbody & "IT Department"
'create logfile
Set objFSO = CreateObject("Scripting.FileSystemObject")
strScriptPath = objfso.GetParentFolderName(WScript.ScriptFullName)
strLogName = TwoDigits(Year(now)) & TwoDigits(Month(now)) & TwoDigits(Day(now)) & ".txt"
strLogFile = strScriptPath & "Logs\" & StrLogName
Set objLogFile = objFSO.OpenTextFile(strLogFile, 8, True)
objLogFile.Writeline "Email Password Check Script started: " & Now
Dim rootDSE, oDomain, DomainContainer
Dim maxPwdAge, numDays
Dim conn, command
Dim ldapStr
Dim rs, oUser, passwordChanged, whenPasswordExpires, daysb4expire
Set rootDSE = GetObject("LDAP://RootDSE")
Set oDomain = GetObject("LDAP://" & strDomainDN)
Set maxPwdAge = oDomain.Get("maxPwdAge")
DomainContainer = rootDSE.Get("defaultNamingContext")
Set conn = CreateObject("ADODB.Connection")
Set command = CreateObject("ADODB.Command")
conn.Provider = "ADSDSOObject"
conn.Open "ADs Provider"
Set command.ActiveConnection = conn
command.Properties("Page Size") = 250
numDays = ABS(CCur((maxPwdAge.HighPart * 2 ^ 32) + maxPwdAge.LowPart) / CCur(864000000000))
'LDAP string to only find user accounts with mailboxes
Dim dteCnv, sec1601, strExpireDate, strRemindDate
dteCnv = DateAdd("d", -numDays, Now)
sec1601 = DateDiff("s","1/1/1601",dteCnv)
strExpireDate = CStr(sec1601) & "0000000"
dteCnv = DateAdd("d", ReminderAge - numDays, Now)
sec1601 = DateDiff("s","1/1/1601",dteCnv)
strRemindDate = CStr(sec1601) & "0000000"
ldapStr = "<LDAP://" & DomainContainer & ">;(& (mailnickname=*)(objectCategory=person)(objectClass=user)(pwdLastSet>=" & strExpireDate & ")(pwdLastSet<=" & strRemindDate & "));adspath;subtree"
command.CommandText = ldapStr
Set rs = command.Execute
While Not rs.EOF
Set oUser = GetObject (rs.Fields(0).Value)
on error resume next
passwordChanged = oUser.PasswordLastChanged
If Err.Number = E_ADS_PROPERTY_NOT_FOUND Then
passwordChanged = "Never"
whenPasswordExpires = Now
elseIf Err.Number <> 0 Then
passwordChanged = "Unknown - " & Err.Description
whenPasswordExpires = Now
else
whenPasswordExpires = DateAdd("d", numDays, passwordChanged)
end if
on error goto 0
daysb4expire = Int(whenPasswordExpires - Now)
'write user info to logfile
objLogFile.Writeline "-----------------------------------------"
objLogFile.Writeline "SAM Acct: " & oUser.SamAccountName
objLogFile.Writeline "Disp Name: " & oUser.displayName
objLogFile.Writeline "UPN: " & oUser.userprincipalname
objLogFile.Writeline "PW Changed: " & passwordChanged
objLogFile.Writeline "PW Expires: " & whenPasswordExpires
objLogFile.Writeline "The password will expire on " & whenPasswordExpires & " (" & daysb4expire & " days from today)."
if daysb4expire <= ReminderAge and daysb4expire > 0 then
objLogFile.Writeline "Expiring soon - sending eMail"
objLogFile.Writeline "*****************************"
strNoteMessage = "Dear " & oUser.displayName & "," & vbcrlf & vbcrlf
strNoteMessage = strNoteMessage & "Your Network password will expire on " & whenPasswordExpires & " (" & daysb4expire & " days from today)." & vbcrlf & vbcrlf
Set objEmail = CreateObject("CDO.Message")
objEmail.From = "me#myCompany.com" 'Your From Address
objEmail.To = oUser.userprincipalname
objEmail.Subject = "Network Password Expiration Notice" 'Message subject
objEmail.TextBody = strNoteMessage & strBody
objEmail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
objEmail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "YOUREXCHANGE.SERVER.DomainName.COM" ' Your mailserver here
objEmail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
objEmail.Configuration.Fields.Update
'objEmail.Send 'commented out right now---so you won't send out the email.
End If
err.clear
rs.MoveNext
Wend
Set oUser = Nothing
Set maxPwdAge = Nothing
Set oDomain = Nothing
objLogFile.Writeline "Email Password Check completed: " & Now & vbcrlf & vbcrlf
objLogFile.Close
Function TwoDigits(t)
TwoDigits = Right("00" & t,2)
End Function
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.
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
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