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
554 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

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

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

Suggested Solutions

Title # Comments Views Activity
Word Template Mail merge with vb.net 4 59
Base1 Encode/Decode 3 68
iframe detection of parent window scale 20 60
Set email body to html using vbscript 6 26
A short article about a problem I had getting the GPS LocationListener working.
This is about my first experience with programming Arduino.
Viewers will learn how to properly install Eclipse with the necessary JDK, and will take a look at an introductory Java program. Download Eclipse installation zip file: Extract files from zip file: Download and install JDK 8: Open Eclipse and …
Learn how to create and modify your own paragraph styles in Microsoft Word. This can be helpful when wanting to make consistently referenced styles throughout a document or template.

896 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

Need Help in Real-Time?

Connect with top rated Experts

16 Experts available now in Live!

Get 1:1 Help Now