View Single Post
  #3   Report Post  
Posted to comp.infosystems,microsoft.public.excel.misc
Chip Pearson Chip Pearson is offline
external usenet poster
 
Posts: 7,247
Default How do I collect excell spreadsheets from 30 people?

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)




"mttmwsn" wrote in message
...
I need to get excel spreadsheets from 30 people once a week.
Instead of having the spreadsheets e-mailed to me, I need to automate the
process. I thought about seting up an ftp site but we have the budget for
a better solution. MS SharePoint seems like overkill because it's not a
collaborative project. I just want to get their data and also possibly
let them correct their data if they make a mistake.