Vbs Multiple Line Email - email

I am using a vbs file to send emails but it sends it in one line only. I want it to be multiple lines with & vbCRLF but it is not working for me.
Please help me with vbs emails with multiple line text.
My code :
Set emailObj = CreateObject("CDO.Message")
emailObj.From = "dc#gail.com"
emailObj.To = "dc#gail.com"
emailObj.Subject = "Test CDO"
emailObj.TextBody = "Test CDO" & vbCRLF & "Test CDO line 2"
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") = "YourUserName"
emailConfig.Fields("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "Password1"
emailConfig.Fields.Update
emailObj.Send
If err.number = 0 then Msgbox "Done"

Here's how I did it, just using ".HTMLBody" to be able to add formatting. Works fine using outlook.
Set objOutlook = CreateObject("Outlook.Application")
Set objMail = objOutlook.CreateItem(0)
with objMail
.Display 'To display message
.To = "test#test.com"
.cc = "test#tested.com"
.Subject = "FYI"
.HTMLBody = "<HTML><BODY><p>Dear Team,</p><P> Please be informed, </p><P> Regards, </p><P><B> My Name </B><br><big><i>My Company</i> </big>(of awesomeness) </br></p></BODY></HTML>"
end with

Related

Add multiple files from folder as attachment to email vbs

I have a vbs script that I have been using to add a file from a folder as an attachment to an email, and then send it automatically through Outlook. Which works great.
The problem that I cannot figure out, is how to add 2 files which are in the same folder, to 1 email. I have been trying several things but the only thing I've been able to manage is adding "file 1" twice in an email, and "file 2" twice in another email.
I am a total novice at this so I apologize if this is some easy fix I can't figure out.
theFolder = "folder location"
Set objFSO = CreateObject("Scripting.FileSystemObject")
For Each objFile In objFSO.GetFolder(theFolder).Files
SendEmail objFSO.GetAbsolutePathName(objFile)
Next
Set objFSO = Nothing
Sub SendEmail(theFileName)
Set objOutlook = CreateObject("Outlook.Application")
Set objMail = objOutlook.CreateItem(0)
objMail.To = "emailaddress"
objMail.cc = ""
objMail.Subject = "subject"
objMail.Body = "body"
objMail.Attachments.Add(theFileName)
objMail.Send
Set objMail = Nothing
Set objOutlook = Nothing
End Sub
Pass the folder name as a parameter instead:
theFolder = "folder location"
SendEmail theFolder
Sub SendEmail(folderName)
Set objOutlook = CreateObject("Outlook.Application")
Set objMail = objOutlook.CreateItem(0)
objMail.To = "emailaddress"
objMail.cc = ""
objMail.Subject = "subject"
objMail.Body = "body"
Set objFSO = CreateObject("Scripting.FileSystemObject")
For Each objFile In objFSO.GetFolder(folderName).Files
objMail.Attachments.Add(objFile.Path)
Next
objMail.Send
Set objMail = Nothing
Set objOutlook = Nothing
Set objFSO = Nothing
End Sub
You need to call the Attachments.Add() for each file in the folder. So, your code may look like that:
theFolder = "folder location"
Sub SendEmail()
Set objOutlook = CreateObject("Outlook.Application")
Set objMail = objOutlook.CreateItem(0)
objMail.To = "emailaddress"
objMail.cc = ""
objMail.Subject = "subject"
objMail.Body = "body"
Set objFSO = CreateObject("Scripting.FileSystemObject")
For Each objFile In objFSO.GetFolder(theFolder).Files
objMail.Attachments.Add(objFSO.GetAbsolutePathName(objFile))
Next
objMail.Send
Set objMail = Nothing
Set objOutlook = Nothing
Set objFSO = Nothing
End Sub

Email will not send through VBS script

I need to send a very simple email with only text to a few recipients, but I'm getting an error.
I don't have an SMTP server to send emails through, but I do have an outlook and I'm logged in through the desktop app.
Here's the script so far:
Set objOutlook = CreateObject("Outlook.Application")
Set objMail = objOutlook.CreateItem(0)
objMail.Display
objMail.to = "recipient#whatever.com"
objMail.Subject = "Test"
objMail.Body = "test"
objMail.Send
objOutlook.Quit
Set objMail = Nothing
Set objOutlook = Nothing
When the script is run, WSH gives the error
line: 10
char: 1
error: Operation Aborted
source: (null)
This is the objMail.Send line.
And my outlook pops up with the proper recipient/subject/body, but it doesn't send.
I can't find anything related to this issue or a work around besides using an SMTP server which as far as I know I can't do.
I have a function defined and in daily use which accepts the various items for creating and sending the email. Remember if you have to create your Outlook instance, you need to log on with the appropriate mail profile in order to send anything. The profile we use here is just called "Outlook". Check what yours is called and include the Namespace stuff I have in mine.
Dim sComputer : sComputer = "." ' selects local machine
Dim oWMIService : Set oWMIService = GetObject("winmgmts:\\" & sComputer & "\root\cimv2")
Dim colItems : Set colItems = oWMIService.ExecQuery ("Select * from Win32_Process Where Name = 'outlook.exe'")
Dim oOutlook : Set oOutlook = CreateObject("Outlook.Application")
Dim oNamespace : Set oNamespace = oOutlook.GetNamespace("MAPI")
If colItems.Count = 0 Then
LOG_Write "Outlook isn't open, logging onto it..."
oNamespace.Logon "Outlook",,False,True ' name of Outlook profile
bOpenedOutlook = True
End If
Dim oFolder : Set oFolder = oNamespace.GetDefaultFolder(olFolderInbox)
oFolder.Display ' Make Outlook visible
Here is basic vbscript simple email
' For Example...
Email_List = "0m3r#Email.com;"
Set App = CreateObject("Outlook.Application")
Set Mail = App.CreateItem(0)
With Mail
.To = Email_List
.CC = ""
.BCC = ""
.Subject = "Hello World"
.HTMLBody = "Bla Bla!!!"
'.Body = strbody
'You can add a file like this
' .Attachments.Add (FilePath)
'use .Send (to send) or .Display (to display the email and edit before sending)
.Display
.send
End With
Set Mail = Nothing
Set App = Nothing
Save is as name.vbs

vbscript check if email is sent

I have created a script to send a weekly report but I don't know how to implement the status message if the email is successfully sent. Currently I just have a message which shows up on confirm to send the message, but that does not really check if the email is sent.
This is my script:
Dim fso, path, file, recentDate, recentFile, ToAddress, FromAddress, MessageSubject, MyTime, MessageBody, MessageAttachment, ol, ns, newMail
Set fso = CreateObject("Scripting.FileSystemObject")
Set recentFile = Nothing
For Each file in fso.GetFolder("C:\REPORTData\temp").Files
If (recentFile is Nothing) Then
If UCase(fso.GetExtensionName(file.name)) <> "PDF" Then
Set recentFile = file
End If
ElseIf (file.DateLastModified > recentFile.DateLastModified) Then
If UCase(fso.GetExtensionName(file.name)) <> "PDF" Then
Set recentFile = file
End If
End If
Next
ToAddress = "randomemail#randomemail.com"
MessageSubject = "Emailing: "+recentFile.Name
MessageBody = "Your message is ready to be sent with the following file or link attachments: "+recentFile.Name
MessageAttachment = "C:\REPORTData\temp\"+recentFile.Name
Set ol = WScript.CreateObject("Outlook.Application")
Set ns = ol.getNamespace("MAPI")
Set newMail = ol.CreateItem(olMailItem)
newMail.Subject = MessageSubject
newMail.Body = MessageBody
newMail.RecipIents.Add(ToAddress)
newMail.Attachments.Add(MessageAttachment)
CurrentWeek = Right(recentFile.Name, 2)
result = MsgBox ("Send REPORT for week: "+CurrentWeek, vbYesNo + vbQuestion, "REPORT Sender v.0.1")
Select Case result
Case vbYes
newMail.Send
Set shell = CreateObject("Wscript.Shell")
shell.Popup "Your REPORT for week "+CurrentWeek+" has been sent", 2, "SUCCESS"
Case vbNo
End Select
Set emailObj = CreateObject("CDO.Message")
emailObj.From = "dcandy#gmail.com"
emailObj.To = "dcandy#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") = "username"
emailConfig.Fields("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "password"
emailConfig.Fields.Update
emailObj.Send
If err.number = 0 then
Msgbox "Done"
Else
Msgbox err.number
End if
is how.

How to add a DKIM signature to classic ASP email sent using CDO

Using something like the below, is it possible to add a header for a DKIM signature? From what I've been reading, it doesn't look like it.. Why not?
Dim iMsg, iConf, Flds
Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")
Set Flds = iConf.Fields
Const cdoSendUsingPort = 2
With Flds
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = cdoSendUsingPort
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "server"
.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = 1
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1 'basic
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "abc"
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "123"
.Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 10
.Update
End With
With iMsg
Set .Configuration = iConf
.To = recipient
.From = "foo#bar.com"
.Subject = "subject"
.HTMLBody = "body"
.Send
End With
If you already have the signature, you could add it to the Fields property of your iMsg object. I've done something similar before to set the "Reply To" and "Return Receipts" addresses:
.Fields("urn:schemas:mailheader:disposition-notification-to") = "test#example.com"
.Fields("urn:schemas:mailheader:return-receipt-to") = "test#example.com"
You could do the same to add any custom header, in your case the DKIM signature. Your iMsg object becomes:
With iMsg
Set .Configuration = iConf
.To = recipient
.From = "foo#bar.com"
.Subject = "subject"
.HTMLBody = "body"
.Fields("urn:schemas:mailheader:DKIM-Signature") = "YOUR_SIGNATURE_HERE"
.Send
End With
I hope that helps.

Send email from Excel in Exchange environment

I have a userform that helps different users fill in data into the spreadsheet. As soon as the data is inserted it should also be sent by email to a few recipients, depending on the options filled in the form.
This happens within a corporate environment using Exchange. I would create a new email account for this file to be able to send the email as an entity and not use the user's email account.
Is this possible? How? I have googled for it and all I can find is how to create a mail message that the user sends from his account.
I've used the code below (source) to send e-mails from Excel-VBA. I've only tested it with my own e-mail account, but I assume you could have it send mail from a different account (msgOne.from = ...), as long as the user has permission to send from that account on the Exchange server.
Dim cdoConfig
Dim msgOne
Set cdoConfig = CreateObject("CDO.Configuration")
With cdoConfig.Fields
.Item(cdoSendUsingMethod) = cdoSendUsingPort
.Item(cdoSMTPServerPort) = 25 '465 ' (your port number) usually is 25
.Item(cdoSMTPServer) = "smtp.mysmtpserver.com" ' your SMTP server goes here
'.Item(cdoSendUserName) = "My Username"
'.Item(cdoSendPassword) = "myPassword"
.Update
End With
Set msgOne = CreateObject("CDO.Message")
Set msgOne.Configuration = cdoConfig
msgOne.To = "someone#somewhere.com"
msgOne.from = "me#here.com"
msgOne.subject = "Test CDO"
msgOne.TextBody = "It works just fine."
msgOne.Send
Unfortunately, I can't test this hypothesis at this time, as I'm only set up to send from one account. Let me know how it works out!
If the excel application is running on a machine with outlook, you can something along the following.
Function SendEmailWithOutlook(er As emailRecord,
recipients As String,
cc As String,
subject As String,
body As String,
attachmentPath As String) As Boolean
Dim errorMsg As String
Dim OutApp As Object
Dim OutMail As Object
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error GoTo errHandle
If (er.useTestEmail = True) Then
recipients = er.emailTest
cc = er.emailTest
End If
With OutMail
If er.emailFrom <> "" Then
.sentOnBehalfOfName = er.emailFrom
End If
.To = recipients
.cc = cc
.bcc = er.emailBcc
.subject = subject
.htmlBody = body
If attachmentPath <> "" Then
.Attachments.Add attachmentPath
End If
.Send 'or use .Display
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
SendEmailWithOutlook = True
Exit Function
errHandle:
errorMsg = "Error sending mail via outlook: " & Err.Description & vbCrLf
errorMsg = errorMsg & "OnBehalfOf:" & er.emailFrom & vbCrLf
errorMsg = errorMsg & "Recipients: " & recipients & vbCrLf
errorMsg = errorMsg & "CC: " & cc & vbCrLf
errorMsg = errorMsg & "BCC: " & er.emailBcc
MsgBox errorMsg
SendEmailWithOutlook = False
End Function
Add a reference to Microsoft Outlook 14.0 Object Library
Why not use the Outlook Object Model?
You can give the current user the right to send on behalf of the specified user, then set MailItem.SentOnBehalfOfName and MailItem.ReplyRecipients (if necessary) properties before callign MailItem.Send.