Want to protect your cyber security and still get fast solutions? Ask a secure question today.Go Premium

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 569
  • Last Modified:

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

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
FaheemAhmadGul
Asked:
FaheemAhmadGul
1 Solution
 
Patrick MatthewsCommented:
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
 
FaheemAhmadGulAuthor Commented:
This has worked perfectly. Many thanks. I am extremely grateful. Regards. Faheem
0

Featured Post

Get expert help—faster!

Need expert help—fast? Use the Help Bell for personalized assistance getting answers to your important questions.

Tackle projects and never again get stuck behind a technical roadblock.
Join Now