One way to do it is as follows. Have the users email you the workbook as an
attachment and tell the users to always include the text "WeekSummary"
within the subject line of the message. The subject can certainly contain
more text that just "WeekSummary", but it does need that particular string.
Then, in Outlook, create a folder named "Test" in your "Personal Folders"
folder. Create another folder named "OldTest". Then, create a Rule (Tools
menu, Rules And Alerts) in Outlook to move any message that has the text
"WeekSummary" in the Subject Line to the folder "Test". Then, once a week
or whenever you want, run the code below. It will save off any attachments
in the messages that have accumulated in the "TestFolder" to a directory
named "C:\Test" with a file name of "SenderName_Date_OriginalFileName.xls".
Finally, it will move the Outlook mail item out of the "Test" folder to the
"OldTest" folder. Of course, you can name "Test" and "OldTest" to anything
you want.
Sub GetOutlookEmails()
Const C_SAVE_FILE_DIR = "C:\Test" '<<<< CHANGE
Dim OLK As Outlook.Application
Dim WeStartedOutlook As Boolean
Dim OLKFolder As Outlook.Folder
Dim OLKNS As Outlook.Namespace
Dim OLKMailItem As Outlook.MailItem
Dim OLKTargetFolder As Outlook.Folder
Dim Attch As Outlook.Attachment
Dim DateString As String
Dim SenderName As String
Dim SaveAsFileName As String
DateString = Format(Now, "dd-mmm-yyyy")
On Error Resume Next
Set OLK = GetObject(, "Outlook.Application") ' note leading comma
Err.Clear
If OLK Is Nothing Then
Set OLK = CreateObject("Outlook.Application") ' no comma
If OLK Is Nothing Then
MsgBox "Cannot get Outlook Application"
Exit Sub
Else
WeStartedOutlook = True
End If
Else
WeStartedOutlook = False
End If
On Error GoTo 0
Set OLKNS = OLK.GetNamespace("MAPI")
Set OLKFolder = OLKNS.Folders("Personal Folders") '<<< CHANGE
Set OLKTargetFolder = OLKFolder.Folders("Test") '<<< CHANGE
For Each OLKMailItem In OLKTargetFolder.Items
If OLKMailItem.Attachments.Count >= 1 Then
Set Attch = OLKMailItem.Attachments(1)
SenderName = OLKMailItem.SenderName
SaveAsFileName = C_SAVE_FILE_DIR & "\" & SenderName & "_" &
DateString & "_" & Attch.Filename
Attch.SaveAsFile SaveAsFileName
OLKMailItem.Move OLKFolder.Folders("OldTest")
End If
Next OLKMailItem
If WeStartedOutlook = True Then
OLK.Quit
End If
End Sub
--
Cordially,
Chip Pearson
Microsoft MVP - Excel, 10 Years
Pearson Software Consulting
www.cpearson.com
(email on the web site)
