Outlook Macro to send All New Files in Folder 1

[supportsvc]

Hello,
I found this Outlook Macro, and not ever having worked with Outlook VBScript / Macros, I am unsure how to incorporate the two as one.

Would like to:
1) Send ALL files in the folder (path)
2) Where the LastModifiedDate is today's date only (there will be same files from previous days with datestamps)


This code sends all the files in a folder (path)

Sub SendFilesbyEmail()
  
   Call SendFiles("C:\ReportResults\Email\")

End Sub
 
Function SendFiles(fldName As String, Optional FileType As String = "*.*")
 
Dim fName As String
Dim sAttName As String

Dim olApp As Outlook.Application
Dim olMsg As Outlook.MailItem
Dim olAtt As Outlook.Attachments
 
Set olApp = Outlook.Application
Set olMsg = olApp.CreateItem(0) ' email
Set olAtt = olMsg.Attachments

' to send all
fName = Dir(fldName)

'to send only certain extensions
'fName = Dir(fldName & FileType)

 Do While Len(fName) > 0
    olAtt.Add fldName & fName
    sAttName = fName & "<br /> " & sAttName
  Debug.Print fName
   fName = Dir
Loop

' send message
With olMsg
  .Subject = "Daily Orders Reports"
  .To = "test@email.com"
  .HTMLBody = "Good morning " & ", <br /><br /> Attached are the Daily Orders Reports for your review."
  .Display
  '.Send
End With
 
End Function

This one sends the newest file BUT only one and not all of the files in the folder

Sub SendNewestFiles()
 Dim objMail As Outlook.MailItem
 Dim fso As Object 'Scripting.FileSystemObject
 Dim strFile As String
 Dim fsoFile 'As Scripting.File
 Dim fsoFldr 'As Scripting.Folder
 Dim dtNew As Date, sNew As String
  
Set fso = CreateObject("Scripting.FileSystemObject")
  
  ' path to folder
 strFile = "C:\Users\Diane Poremsky\Pictures\"
    
 Set fsoFldr = fso.GetFolder(strFile)
 dtNew = Now - 0.25 ' 6 hours ago
     
For Each fsoFile In fsoFldr.Files

' if date created is less than 6 hours ago
' can use .DateLastModified
If fsoFile.DateCreated > dtNew Then

sNew = fsoFile.Path
          
Set objMail = Application.CreateItem(olMailItem)

 With objMail
 .To = "email@address.com"
 .BodyFormat = olFormatPlain
 .Attachments.Add sNew
 .Display ' .send
 End With

End If
Next fsoFile
  
End Sub

Can someone please help and show how to combine the two as one so that one email attaches all of the files n the folder with the lastmodifieddate as today only?

Thank you!

 

[SkipVought]

Hi,

Just shifted things around for you...

'first assign the MailItem Object
    Set objMail = Application.CreateItem(olMailItem)
    
    With objMail
        
'then loop thru all files to find the one(s) to attach
        For Each fsoFile In fsoFldr.Files
        
            ' if date created is less than 6 hours ago
            ' can use .DateLastModified
            If fsoFile.DateCreated > dtNew Then
                
                .Attachments.Add fsoFile.Path
                
            End If
        Next fsoFile
'then complete & send
        .To = "email@address.com"
        .BodyFormat = olFormatPlain
        .Display ' .send
    End With

Skip,

_{Just traded in my OLD subtlety...
for a NUance!}

 

[DjangMan]

I might recommend toggling the archive flag on files in the folder once you've sent them or, if allowed, move them to a "Sent" sub-folder. If your macro doesn't run, for whatever reason, you've hard code how it finds the files based on date/time. So if you need to send files from two days ago you can't without getting into the code. Putting the files into a sub-folder allows you to easily see what has been sent and what needs to be sent and your macro could run multiple times in the same day without worrying about re-sending the same file.

 

[supportsvc]

Thank you SkipVought

I'll try it.

DjangMan,
Not sure I follow?
The modified code is to look for only today's DateModified date and send all of those files in the folder.

 

[DjangMan]

I'm just being Devil's Advocate/Pessimist and asking, what if your code doesn't run on Monday for whatever reason but works on Tuesday? Monday's files will remain unsent and you won't have a way to send them without editing the macro code for a 'one off run' or by manually sending the files. By marking the sent files in some way (flip the archive bit, move them to a 'sent files' folder) then your code can be a little simpler by telling it to send all of the files it can see.

(Edited for spelling)

 

[supportsvc]

SkipVought ... not sure how to edit either of the original codes with yours to make both work as one?

DjangMan, there is definitely a possibility that it could fail one day.
Which I was thinking to use Windows Task Scheduler. Hopefully that works. Only time I had Task Scheduler work is to launch VBScript that opens Access and Run the Macros

dim accessApp
set accessApp = createObject("Access.Application")
 
accessApp.OpenCurrentDataBase("\\File02\usfs\Crystal and Excel Reports - Phoenix\CrystalReports\Memberships\MembershipsReporting.accdb")

accessApp.Run "ExportRptsMacro"
accessApp.Quit
set accessApp = nothing

 

[SkipVought]

‘
   Set fso = CreateObject("Scripting.FileSystemObject")
  
  ' path to folder
   strFile = "C:\Users\Diane Poremsky\Pictures\"
    
   Set fsoFldr = fso.GetFolder(strFile)
   dtNew = Now - 0.25 ' 6 hours ago

‘New code goes here............

'first assign the MailItem Object
    Set objMail = Application.CreateItem(olMailItem)
    
    With objMail
        
'then loop thru all files to find the one(s) to attach
        For Each fsoFile In fsoFldr.Files
        
            ' if date created is less than 6 hours ago
            ' can use .DateLastModified
            If fsoFile.DateCreated > dtNew Then
                
                .Attachments.Add fsoFile.Path
                
            End If
        Next fsoFile
'then complete & send
        .To = "email@address.com"
        .BodyFormat = olFormatPlain
        .Display ' .send
    End With 
End Sub

Skip,

_{Just traded in my OLD subtlety...
for a NUance!}

 

[supportsvc]

Ok, thank you!

Ugh ... well it is grabbing ALL the files and not the newest ones only

Sub SendNewestFiles()
 Dim objMail As Outlook.MailItem
 Dim fso As Object 'Scripting.FileSystemObject
 Dim strFile As String
 Dim fsoFile 'As Scripting.File
 Dim fsoFldr 'As Scripting.Folder
 Dim dtNew As Date, sNew As String
  
Set fso = CreateObject("Scripting.FileSystemObject")
  
  ' path to folder
 strFile = "C:\ReportResults\Email\"
    
 Set fsoFldr = fso.GetFolder(strFile)
 dtNew = Now - 0.25 ' 6 hours ago
 
'first assign the MailItem Object
    Set objMail = Application.CreateItem(olMailItem)
    
    With objMail
        
'then loop thru all files to find the one(s) to attach
        For Each fsoFile In fsoFldr.Files
        
            ' if date created is less than 6 hours ago
            ' can use .DateLastModified
            If fsoFile.DateCreated < dtNew Then
                
                .Attachments.Add fsoFile.Path
                
            End If
        Next fsoFile
'then complete & send
        .To = "email@test.com"
        .BodyFormat = olFormatPlain
        .Display
        '.send
    End With
End Sub

 

[SkipVought]

Checkout faq707-4594.

Well, you’re asking for...

If fsoFile.DateCreated < dtNew Then

I’d change it to this maybe...

If fsoFile.DateCreated > dtNew Then

I don’t know what files get put in this folder when. But your logic is getting EVERYTHING in the folder less than 6 hours earlier than your run time.


Skip,

_{Just traded in my OLD subtlety...
for a NUance!}

 

[supportsvc]

What is it to just have the most recent files?
Or only files with today's date whether it's DateModified or DateCreated?

The Date Modified and Date Created are the same

It works when I change the dtNew to Now - .75 for testing purposes.

 

[SkipVought]

If you periodically perform this, how about any CreateDate > [MostRecentProcessDate] whic woud be the last process date.

Skip,

_{Just traded in my OLD subtlety...
for a NUance!}

 

[supportsvc]

?

It only runs once a day, anytime of the but it's basically a daily process to send one email of all the reports in the one folder.

It has date stamps in the file name, but rather than that, using the DateCreated or DateModified as to send only the Current Date / Today reports only.

 

[SkipVought]

So what’s the issue?

Skip,

_{Just traded in my OLD subtlety...
for a NUance!}

 

[SkipVought]

How about...

If fsoFile.DateModified > Date - 1 Then

Skip,

_{Just traded in my OLD subtlety...
for a NUance!}

 

[SkipVought]

Skip,

_{Just traded in my OLD subtlety...
for a NUance!}