Dim strFile1, strFile2, objMail, fso, objOutlook
Const FOLDER1 = "C:\Ordner1\Ordner2\"
Const FOLDER2 = ""
Const MAILTO = "xxxx@xxxx.de"
Const SUBJECT = "Löhne"
Const BODY = "Die Löhne finden sie im Anhang."
Set fso = CreateObject("Scripting.Filesystemobject")
Set objOutlook = CreateObject("Outlook.Application")
strFile1 = getNewestFile(FOLDER1, "")
strFile2 = getNewestFile(FOLDER2, "")
Set objMail = objOutlook.CreateItem(0)
With objMail
.To = MAILTO
.SUBJECT = SUBJECT
.BODY = BODY
If strFile1 = "" Then
MsgBox "Es wurde keine Datei in Ordner 1 gefunden", vbExclamation
Else
.Attachments.Add strFile1
End If
If strFile2 = "" Then
MsgBox "Es wurde keine Datei in Ordner 2 gefunden", vbExclamation
Else
.Attachments.Add strFile2
End If
.Display
End With
Set fso = Nothing
Set objOutlook = Nothing
End If
End If
End Sub
Function getNewestFile(strFolder, strType)
Set objFile = Nothing
For Each file In fso.GetFolder(strFolder).Files
If strType <> "" Then
If fso.GetExtensionName(file.Path) = strType Then
If objFile Is Nothing Then
Set objFile = file
ElseIf (file.DateLastModified > objFile.DateLastModified) Then
Set objFile = file
End If
End If
Else
If objFile Is Nothing Then
Set objFile = file
ElseIf (file.DateLastModified > objFile.DateLastModified) Then
Set objFile = file
End If
End If
Next
If Not objFile Is Nothing Then
getNewestFile = objFile.Path
Else
getNewestFile = ""
End If
End Function