I'm using below code to send some scheduled emails with attachments.
I need to add the mail From section (this way I can choose which email account to send from).
Any help is appreciated.
' Define location and names for file selection
strBaseDir = "C:\Users\Wassim.QA-DOMAIN\Desktop\Export Invoices"
strBaseName = "4667-"
arrExt = Array(".csv", ".txt", ".pdf" ,"xls" ,"xlsx")
' Specify email related information
MailTo = "email@example.com"
Subject = "Files"
Body = "***** Please see attached *****"
' Create file system object
Set objFSO = CreateObject("Scripting.FileSystemObject")
' Access the folder where the files exist
Set objFolder = objFSO.GetFolder(strBaseDir)
' Process all files in this folder, and look for name matches
For Each objFile in objFolder.Files
If CheckFileName(objFile.Name) Then
Attachments = Attachments & "," & objFile.Path
If Left(Attachments, 1) = "," Then
Attachments = Mid(Attachments, 2)
If Attachments <> "" Then
Email MailTo, Subject, Body, Attachments
' Subroutine to send the email with the file attached
Sub Email (MailTo, Subject, Body, Attachments)
Set App = CreateObject("Outlook.Application")
Set Item = App.CreateItem(0)
.To = MailTo
.CC = ""
.BCC = "firstname.lastname@example.org"
.Subject = Subject
.HTMLBody = "***** " & Body & " *****"
Set MsgAttachments = Item.Attachments
For Each Attachment In Split(Attachments, ",")
' Function to determine if we should process this file or not
' Assume we don't process it
CheckFileName = False
' Check start of file name for a match
If LCase(Left(strName, Len(strBaseName))) = LCase(strBaseName) Then
' Check included file types and see if we want this one
For Each strExt in arrExt
If LCase(Right(strName, Len(strExt))) = LCase(strExt) Then
CheckFileName = True
' Delete files that starts with
On Error Resume Next
Set obj = CreateObject("Scripting.FileSystemObject")