Solved

Word Macro that will email the most recently saved file from a predefined folder to a predefined email address

Posted on 2009-05-10
2
557 Views
Last Modified: 2013-11-10
I would like to have code for a macro that will create an email message to a predefined email address with a predefined subject and message body
and attach to this email the most recently saved Word Document from C:\Test Folder

I already have code for a similar macro which attaches the currently active document to an email message to a predefined email address. I need some modification of it so that instead of attaching the currently active word document, the code attaches the most recently saved word document from the folder (C:\Test Folder)
I include the code (which was very kindly provided by an expert to a related question)

Sub Email()
 
Dim ol As Object 'outlook application object
Set ol = CreateObject("Outlook.Application") 'create an instance of the outlook application
 
Dim olItem As Object 'outlook mail object
Set olItem = ol.CreateItem(0) 'create an instance of an outlook mail object...the 0 indicates you are creating an emial
 
'using the email object
With olItem
    .To = "email@address.com" 'email addressee
    .Subject = "Subject"      'email subject
    .Body = "Message"         'email message
    .Attachments.Add ActiveDocument.FullName 'full path and name of active document to attach to the email
    .Display 'show the email (user need to click the send button)
    '.Send    'sends the email (Outlook security prompt will appear)
End With
 
'clear the outlook mail object
Set olItem = Nothing
'clear the outlook application object
Set ol = Nothing
 
End Sub

Open in new window

0
Comment
Question by:FaheemAhmadGul
2 Comments
 
LVL 92

Accepted Solution

by:
Patrick Matthews earned 500 total points
ID: 24350955
Add the UDF below to your project, then amend your original code to:

Sub Email()
 
Dim ol As Object 'outlook application object
Set ol = CreateObject("Outlook.Application") 'create an instance of the outlook application
 
Dim olItem As Object 'outlook mail object
Set olItem = ol.CreateItem(0) 'create an instance of an outlook mail object...the 0 indicates you are creating an emial
 
'using the email object
With olItem
    .To = "email@address.com" 'email addressee
    .Subject = "Subject"      'email subject
    .Body = "Message"         'email message
    .Attachments.Add FileByDate("c:\test folder", "DateLastModified", "newest", "path", ".doc*")
    .Display 'show the email (user need to click the send button)
    '.Send    'sends the email (Outlook security prompt will appear)
End With
 
'clear the outlook mail object
Set olItem = Nothing
'clear the outlook application object
Set ol = Nothing
 
End Sub
Function FileByDate(LookInDir As String, DateParam As Variant, DateSort As Variant, _
    ReturnType As Variant, ParamArray Extensions())
    
    ' Function by Patrick Matthews
    '
    ' Function looks in specified directory, and depending on the arguments selected returns
    ' the file name and path for the oldest/newest file in that folder, or the date associated
    ' with that file. Function can use DateCreated, DateLastAccessed, or DateLastModified to
    ' determine oldest/newst.
    '
    ' Arguments:
    '
    ' LookInDir: the folder you want to analyze.  This function does NOT look in "descendant"
    '   subfolders
    '
    ' DateParam: indicates whether to use "DateCreated" (1), "DateLastAccessed" (2), or
    '   DateLastModified (3).  You may use the ordinal above or the name of the property as a
    '   string
    '
    ' DateSort: indicates whether to use "oldest" (1) or "newest" (2) date.  You may use
    '   ordinal or the string
    '
    ' ReturnType: indicates whether to return "name"/"path"/"filename" (1) or "date" (2).
    '   You may use ordinal or the string
    '
    ' Extensions: list of 1 - 32 "extensions" you want to use for a match for file types.  For
    '   example, "xls" will match all *.xls files.  You may use wild cards in the extension list.
    '   Note that these are not necessarily limited to true "extensions"--for example, you could
    '   use "main.mdb" to match all files ending in "main.mdb"
    '
    ' If no files match the arguments function returns zero length string
    
    Dim fso As Object 'Scripting.FileSystemObject
    Dim fld As Object 'Scripting.Folder
    Dim fil As Object 'Scripting.File
    Dim TestDate As Date
    Dim CurrentDate As Date
    Dim NameAndPath As String
    Dim Ext As Variant
    
    Const HighDate As Date = #12/31/2999#
    Const LowDate As Date = #1/1/1900#
    
    ' Set to lower case to make string comparisons easier, if applicable
    
    If Not IsNumeric(DateParam) Then DateParam = LCase(DateParam)
    If Not IsNumeric(DateSort) Then DateSort = LCase(DateSort)
    If Not IsNumeric(ReturnType) Then ReturnType = LCase(ReturnType)
    
    ' Set defaults for test date
    
    Select Case DateSort
        Case 1, "first", "oldest"
            TestDate = HighDate
            DateSort = 1
        Case 2, "last", "newest"
            TestDate = LowDate
            DateSort = 2
        Case Else:
            FileByDate = ""
            GoTo Cleanup
    End Select
    
    ' Validate that there is at least one extension to test
    
    If UBound(Extensions) = -1 Then
        FileByDate = ""
        GoTo Cleanup
    End If
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set fld = fso.GetFolder(LookInDir)
    
    ' Loop through files in folder
    
    For Each fil In fld.Files
        
        ' Check file name against each extension in the list
        
        For Each Ext In Extensions
            If LCase(fil.Path) Like "*" & LCase(Ext) Then
                
                ' Grab appropriate date based on DateParam argument
                
                Select Case DateParam
                    Case 1, "datecreated": CurrentDate = fil.DateCreated
                    Case 2, "datelastaccessed": CurrentDate = fil.DateLastAccessed
                    Case 3, "datelastmodified": CurrentDate = fil.DateLastModified
                    Case Else
                        FileByDate = ""
                        GoTo Cleanup
                End Select
                
                ' Check to see whether CurrentDate "beats" the current TestDate
                
                If DateSort = 1 Then
                    If CurrentDate < TestDate Then
                        TestDate = CurrentDate
                        NameAndPath = fil.Path
                    End If
                Else
                    If CurrentDate > TestDate Then
                        TestDate = CurrentDate
                        NameAndPath = fil.Path
                    End If
                End If
                
                ' No need to test the other extensions once we find one that works!
                
                Exit For
            End If
        Next
    Next
    
    If NameAndPath <> "" Then
        
        ' Determine return value of function
        
        Select Case ReturnType
            Case 1, "name", "path", "filename": FileByDate = NameAndPath
            Case 2, "date": FileByDate = TestDate
            Case Else: FileByDate = ""
        End Select
    End If
    
Cleanup:
    
    ' Release object variables
    
    Set fil = Nothing
    Set fld = Nothing
    Set fso = Nothing
    
End Function

Open in new window

0
 

Author Closing Comment

by:FaheemAhmadGul
ID: 31579918
This has worked perfectly. Many thanks. I am extremely grateful. Regards. Faheem
0

Featured Post

Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

In this post we will learn how to make Android Gesture Tutorial and give different functionality whenever a user Touch or Scroll android screen.
You need to know the location of the Office templates folder, so that when you create new templates, they are saved to that location, and thus are available for selection when creating new documents.  The steps to find the Templates folder path are …
Office 365 is currently available in five editions. Three of them are for business use: Office 365 Business Essentials, Office 365 Business, and Office 365 Business Premium. Two of them are for home/personal use: Office 365 Home and Office 365 Perso…
With the power of JIRA, there's an unlimited number of ways you can customize it, use it and benefit from it. With that in mind, there's bound to be things that I wasn't able to cover in this course. With this summary we'll look at some places to go…

735 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question