Sub SaveLatestAttachment()
Dim olApp As Outlook.Application
Dim oMail As Outlook.MailItem
Dim NS As Outlook.NameSpace
Dim oFolder As Outlook.Folder
Dim SaveInFolderName As String
Dim SaveInFolder As String
Dim subFolderName As String
Dim strFile As String
Dim Item As Object
Dim Items As Outlook.Items
Dim x()
Dim i As Long
SaveInFolderName = CreateObject("WScript.Shell").SpecialFolders(16)
subFolderName = "EmailAttachments"
SaveInFolder = SaveInFolderName & "\" & subFolderName & "\"
Set olApp = New Outlook.Application
Set NS = olApp.GetNamespace("MAPI")
Set oFolder = NS.GetDefaultFolder(olFolderInbox).Parent.Folders("Test")
ReDim x(1 To oFolder.Items.Count, 1 To 4)
Set Items = oFolder.Items
Items.Sort "[ReceivedTime]", True
For Each Item In Items
If TypeOf Item Is Outlook.MailItem Then
Set oMail = Item
If LCase(oMail.Subject) = "my daily report" Then
If oMail.Attachments.Count > 0 Then
For i = 1 To oMail.Attachments.Count
strFile = oMail.Attachments(i).FileName
If InStr(LCase(strFile), "my report") > 0 Then
MsgBox oMail.ReceivedTime
strFile = SaveInFolder & strFile
On Error Resume Next
Kill strFile
On Error GoTo 0
oMail.Attachments(i).SaveAsFile strFile
GoTo ExitSub
End If
Next i
End If
End If
End If
Next Item
ExitSub:
Set olApp = Nothing
MsgBox "Task Completed Successfully.", vbInformation
End Sub
ASKER
ASKER
Private Sub Application_NewMail()
Call SaveAttachments
End Sub
Microsoft Outlook is a personal information manager from Microsoft, available as a part of the Microsoft Office suite. Although often used mainly as an email application, it also includes a calendar, task manager, contact manager, note-taker, journal, and web browser.
TRUSTED BY
Open in new window
To convert to all manner of formats.
https://ask.libreoffice.or
Libreoffice runs under Java, or really JRE, so runs on all Operating Systems, including Windows.