Attach the most recent .XML file located at C:\Users\ then email

[bowlesstan]

Help i am looking to attach the most recent .XML file located at C:\Users\Downloads\

then email the attachment

I have looked on forums but not found anything that worked.
Below is the basic setup for the rest of the email.


Private Sub MAIL_Click()

Dim OApp As Object
Dim OMail As Object
Dim signature As String

Set OApp = CreateObject("Outlook.Application")
Set OMail = OApp.CreateItem(0)
With OMail
.Display
End With
signature = OMail.body
With OMail
.To = ""
.Subject = ""
.Attachments.Add ("C:\Users\.xml")
.body = "FYI" & vbNewLine & signature
.Send

End With

On Error GoTo 0

Set OMail = Nothing
Set OApp = Nothing

End Sub

Any help is much appreciated :banghead:

[gmayor]

I assume that you are running this code from another Office application? If not you don't need to create an Outlook application as yolu are already in one.
You will need a function to identify the latest xml file in the folder, and if you want to retain your signature (and not running the code from Outlook) you will need the code indicated at the top of the macro to start Outlook properly. The code will pick the last modified xml file from your downloads folder.


Option Explicit

Private Sub MAIL_Click()
'Requires the code from http://www.rondebruin.nl/win/s1/outlook/openclose.htm
'Graham Mayor - http://www.gmayor.com - Last updated - 21 Jun 2018
Dim OApp As Object
Dim OMail As Object
Dim olInsp As Object
Dim wdDoc As Object
Dim oRng As Object
Dim signature As String
Dim strPath As String
Dim strAttach As String

strPath = Environ("USERPROFILE") & Chr(92) & "Downloads\"
strAttach = strPath & GetMostRecentFile(strPath, "xml")
Set OApp = OutlookApp()
Set OMail = OApp.CreateItem(0)
With OMail
.to = ""
.Subject = ""
.Display
Set olInsp = .GetInspector
Set wdDoc = olInsp.WordEditor
Set oRng = wdDoc.Range
oRng.Collapse 1
oRng.Text = "FYI"
.Attachments.Add strAttach
'.Send
End With
Set OMail = Nothing
Set OApp = Nothing
End Sub


Private Function GetMostRecentFile(strPath As String, strExt As String) As String
'Graham Mayor - http://www.gmayor.com - Last updated - 21 Jun 2018
Dim fso As Object
Dim oFile As Object
Dim oFolder As Object
Dim strfilename As String
Dim dteDate As Date
Dim iPos As Integer

On Error GoTo err_Handler
strExt = Replace(strExt, Chr(46), "")
Set fso = CreateObject("Scripting.FileSystemObject")
Set oFolder = fso.GetFolder(strPath)
dteDate = CDate("01/01/1900 01:01:01")
For Each oFile In oFolder.Files
iPos = InStrRev(oFile.Name, Chr(46)) + 1
If Mid(LCase(oFile.Name), iPos) = LCase(strExt) Then
If CDate(oFile.DateLastModified) > dteDate Then
dteDate = CDate(oFile.DateLastModified)
strfilename = oFile.Name
End If
End If
Next oFile
GetMostRecentFile = strfilename
lbl_Exit:
Set fso = Nothing
Set oFolder = Nothing
Set oFile = Nothing
Exit Function
err_Handler:
Err.Clear
GetMostRecentFile = ""
GoTo lbl_Exit
End Function

[Logit]

.
Here is another method using your code :



Option Explicit


Sub EmailLatestFileInFolder()


'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 = "C:\Users\My\Downloads\"

'Make sure that the path ends in a backslash
If Right(MyPath, 1) <> "\" Then MyPath = MyPath & "\"

'Get the first Excel file from the folder
MyFile = Dir(MyPath & "*.xl*", 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 Excel 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 Excel file from the folder
MyFile = Dir

Loop

Dim OApp As Object
Dim OMail As Object
Dim signature As String


Set OApp = CreateObject("Outlook.Application")
Set OMail = OApp.CreateItem(0)
With OMail
.Display
End With
signature = OMail.body
With OMail
.To = "Who It May Concern@email.com"
.Subject = "Please See Attached Document"
.Attachments.Add MyPath & LatestFile
.body = "FYI" & vbCrLf & vbCrLf & "signature"
.Display
End With


On Error GoTo 0


Set OMail = Nothing
Set OApp = Nothing

End Sub