Add multiple files from folder as attachment to email vbs - email

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

Related

MS Access 2010 - Send an automated email after form has been submitted

I've been looking at trying to get my Access database to automatically send an email to notify me of an addition once a user has entered a new record through a form. I've tried using:
Private Sub Form_AfterInsert()
Dim oApp As Outlook.Application
Dim oMail As MailItem
Set oApp = CreateObject("Outlook.application")
Set oMail = oApp.CreateItem(olMailItem)
oMail.Body = "Body of the email"
oMail.Subject = "Test Subject"
oMail.To = "Someone#somewhere.com"
oMail.Send
Set oMail = Nothing
Set oApp = Nothing
End Sub
But it just gives me the error: Compile error: User-defined type not defined.

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.

Vbs Multiple Line 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

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.