×
INTELLIGENT WORK FORUMS
FOR COMPUTER PROFESSIONALS

Log In

Come Join Us!

Are you a
Computer / IT professional?
Join Tek-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!
  • Students Click Here

*Tek-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Students Click Here

Jobs

Outlook Macro to send All New Files in Folder

Outlook Macro to send All New Files in Folder

Outlook Macro to send All New Files in Folder

(OP)
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)

CODE

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

CODE

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!

RE: Outlook Macro to send All New Files in Folder

Hi,

Just shifted things around for you...

CODE

'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,

glassesJust traded in my OLD subtlety...
for a NUance!tongue

RE: Outlook Macro to send All New Files in Folder

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.

RE: Outlook Macro to send All New Files in Folder

(OP)
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.

RE: Outlook Macro to send All New Files in Folder

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)

RE: Outlook Macro to send All New Files in Folder

(OP)
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

CODE

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 

RE: Outlook Macro to send All New Files in Folder

CODE

‘
   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,

glassesJust traded in my OLD subtlety...
for a NUance!tongue

RE: Outlook Macro to send All New Files in Folder

(OP)
Ok, thank you!

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

CODE

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 

RE: Outlook Macro to send All New Files in Folder

Checkout FAQ707-4594: How to use the Watch Window as a Power Programming Tool.

Well, you’re asking for...

CODE

If fsoFile.DateCreated < dtNew Then 

I’d change it to this maybe...

CODE

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,

glassesJust traded in my OLD subtlety...
for a NUance!tongue

RE: Outlook Macro to send All New Files in Folder

(OP)
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.

RE: Outlook Macro to send All New Files in Folder

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

Skip,

glassesJust traded in my OLD subtlety...
for a NUance!tongue

RE: Outlook Macro to send All New Files in Folder

(OP)
?

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.

RE: Outlook Macro to send All New Files in Folder

So what’s the issue?

Skip,

glassesJust traded in my OLD subtlety...
for a NUance!tongue

RE: Outlook Macro to send All New Files in Folder

How about...

CODE

If fsoFile.DateModified > Date - 1 Then 

Skip,

glassesJust traded in my OLD subtlety...
for a NUance!tongue

RE: Outlook Macro to send All New Files in Folder

👍

Skip,

glassesJust traded in my OLD subtlety...
for a NUance!tongue

Red Flag This Post

Please let us know here why this post is inappropriate. Reasons such as off-topic, duplicates, flames, illegal, vulgar, or students posting their homework.

Red Flag Submitted

Thank you for helping keep Tek-Tips Forums free from inappropriate posts.
The Tek-Tips staff will check this out and take appropriate action.

Reply To This Thread

Posting in the Tek-Tips forums is a member-only feature.

Click Here to join Tek-Tips and talk with other members! Already a Member? Login

Close Box

Join Tek-Tips® Today!

Join your peers on the Internet's largest technical computer professional community.
It's easy to join and it's free.

Here's Why Members Love Tek-Tips Forums:

Register now while it's still free!

Already a member? Close this window and log in.

Join Us             Close