How to get all .XML files from a specific folder and attached in email and send it in VBA for a specific date (today for example) - vba

Question

I made a VBA code that gets the last saved file in a folder and send it via Outlook, but I need to get all files from a specific date (from current day) not only the last one.
Sub SendEmail_Demo()
'Declare the variables
Dim MyPath As String
Dim MyFile As String
Dim LatestFile As String
Dim LatestDate As Date
Dim LMD As Date
'Specify the path to the folder
MyPath = "..................\XML\"
'Make sure that the path ends in a backslash
If Right(MyPath, 1) <> "\" Then MyPath = MyPath & "\"
'Get the first XML file from the folder
MyFile = Dir(MyPath & "*.xml*", Today(), vbNormal)
'If no files were found, exit the sub
If Len(MyFile) = 0 Then
MsgBox "No files were found...", vbExclamation
Exit Sub
End If
'Loop through each XML file in the folder
Do While Len(MyFile) > 0
'Assign the date/time of the current file to a variable
LMD = FileDateTime(MyPath & MyFile)
'If the date/time of the current file is greater than the latest
'recorded date, assign its filename and date/time to variables
If LMD > LatestDate Then
LatestFile = MyFile
LatestDate = LMD
End If
'Get the next XML file from the folder
MyFile = Dir
Loop
Dim OutlookApp As Outlook.Application
Dim OutlookMail As Outlook.MailItem
Set OutlookApp = New Outlook.Application
Set OutlookMail = OutlookApp.CreateItem(olMailItem)
With OutlookMail
.BodyFormat = olFormatHTML
.Display
.HTMLBody = "Hi demo"
.To = "myEmial.com"
.Subject = "Test demo"
.Attachments.Add MyPath & LatestFile
.Send
End With
End Sub

Answer 1

Try this:
Sub SendEmail_Demo()
Dim MyPath As String
Dim MyFile As String
'Specify the path to the folder
MyPath = "..................\XML\"
'Make sure that the path ends in a backslash
If Right(MyPath, 1) <> "\" Then MyPath = MyPath & "\"
'Get the first XML file from the folder
MyFile = Dir(MyPath & "*.xml", vbNormal)
'If no files were found, exit the sub
If Len(MyFile) = 0 Then
MsgBox "No files were found...", vbExclamation
Exit Sub
End If
Dim filesToSend As New Collection
Dim fileFullName As Variant
Dim startOfToday As Date
startOfToday = Now() - Timer() / 86400!
'Timer() ... elapsed seconds since the start of today
'86400 ..... seconds per day
'Loop through each XML file in the folder
Do While Len(MyFile) > 0
fileFullName = MyPath & MyFile
'If the date/time of the current file is greater than
'today 00:00 then add the file to 'filesToSend collection
If FileDateTime(fileFullName) > startOfToday Then
filesToSend.Add fileFullName
End If
'Get the next XML file from the folder
MyFile = Dir
Loop
Dim OutlookApp As Outlook.Application
Dim OutlookMail As Outlook.Mailitem
Set OutlookApp = New Outlook.Application
Set OutlookMail = OutlookApp.CreateItem(olMailItem)
With OutlookMail
.BodyFormat = olFormatHTML
.Display
.HTMLBody = "Hi demo"
.To = "myEmial.com"
.Subject = "Test demo"
'Attach all the files to one mail
For Each fileFullName In filesToSend
.Attachments.Add fileFullName
Next fileFullName
.SEND
End With
End Sub