Automatically Save Attachment Based On EXCEL Value?

[NYCAnalyst]

Hi,

I get a bunch of reports daily in my e-mail. I already have Outlook rules set up to forward them to certain folders if they are sent by certain people / have a certain subject.

What I want to know is a macro (I assume that this will be placed in "ThisOutlookSession") that can automatically save the attachment coming in a certain folder in a certain place, with a different name.

For example, save an attachment as cell B5 of "Sheet1" of the attachment in a certain folder.

Thanks much.

[Demosthine]

Good Evening.

If you check out Thread 7996, it should have almost all of the answers for you. It certainly has the hardest parts of it regarding access the individual mail messages and then the attachments. That's a great place to start your project.

Scott

[NYCAnalyst]

Hi Scott,

Thanks, I set up a script to run whenever an email containing the file gets added to the folder I want, but how do I get the script to save the file based on an excel value?

This is the script I have so far:

Public Sub RuleScriptSaveTemp(Item As MailItem)

Dim olAtt As Attachment
Dim i As Integer

If Item.Attachments.Count > 0 Then
For i = 1 To Item.Attachments.Count
Set olAtt = Item.Attachments(i)
olAtt.SaveAsFile "C:\Temp\" & olAtt.Sheets("Sheet1").Range("C2").Value
Next
End If
Set olAtt = Nothing

End Sub

[Demosthine]

Good Evening.

Once you've reached this point, you will have to save the attachment either to a temporary directory or a static directory. You can open the file through code or use the Excel4Macro called GetData. Ultimately, though, you have to save the file after you retrieve the data with the new name or simply rename it.

For information on opening the workbook through code and getting the data manually, see this thread here.

For information on the GetData Macro, see Knowledge Base Article. (http://vbaexpress.com/kb/getarticle.php?kb_id=286&PHPSESSID=279d5f78c087459f5a79619e3273662b)

Happy Reading.
Scott

[NYCAnalyst]

Good Evening.

Once you've reached this point, you will have to save the attachment either to a temporary directory or a static directory. You can open the file through code or use the Excel4Macro called GetData. Ultimately, though, you have to save the file after you retrieve the data with the new name or simply rename it.

For information on opening the workbook through code and getting the data manually, see this thread here.

For information on the GetData Macro, see Knowledge Base Article. (http://vbaexpress.com/kb/getarticle.php?kb_id=286&PHPSESSID=279d5f78c087459f5a79619e3273662b)

Happy Reading.
Scott

Those are excel macros, how can I get that to work in Outlook 07?

Thanks.

[Demosthine]

Good Afternoon.

Sorry it took so long, but I had some other things come up.

So here is some code that I have working as requested. There are a couple of things you'll want to note.

01.) Each attachment is saved to your Temporary Folder that is defined in your Environment Variables.

02.) There is a separate Destination variable that you'll want to change to whatever your actual Save To Folder is. I have it set back to the Temporary Folder for now.

03.) As requested, it takes the value from Cell B5 as the new filename.

04.) After the Save As is complete, it deletes the temporary file.


Option Explicit
Public Sub Save_Attachments()
Dim folInbox As MAPIFolder
Dim folSaved As MAPIFolder
Dim olmMessage As MailItem
Dim olaAttachment As Attachment
Dim strTemp As String
Dim strDestination As String
Dim strFilePath As String
Dim appExcel As Object
Dim wbkAttachment As Object
Set folInbox = Session.GetDefaultFolder(olFolderInbox)
Set folSaved = folInbox.Folders.Item("Saved")
strTemp = Environ("Temp")
strDestination = strTemp
Set appExcel = CreateObject("Excel.Application")
For Each olmMessage In folSaved.Items
If olmMessage.UnRead = True Then
olmMessage.UnRead = False
If olmMessage.Attachments.Count > 0 Then
For Each olaAttachment In olmMessage.Attachments
With olaAttachment
strFilePath = strTemp & "\" & .FileName
.SaveAsFile (strFilePath)
Set wbkAttachment = appExcel.workbooks.Open(strFilePath)
With wbkAttachment
.SaveAs strDestination & "\" & _
.Worksheets("Sheet1").Range("B5").Value
.Close
End With

Kill strFilePath
End With
Next olaAttachment
End If
End If
Next olmMessage
appExcel.Quit
End Sub


Enjoy.
Scott

[NYCAnalyst]

Good Afternoon.

Sorry it took so long, but I had some other things come up.

So here is some code that I have working as requested. There are a couple of things you'll want to note.

01.) Each attachment is saved to your Temporary Folder that is defined in your Environment Variables.

02.) There is a separate Destination variable that you'll want to change to whatever your actual Save To Folder is. I have it set back to the Temporary Folder for now.

03.) As requested, it takes the value from Cell B5 as the new filename.

04.) After the Save As is complete, it deletes the temporary file.


Option Explicit
Public Sub Save_Attachments()
Dim folInbox As MAPIFolder
Dim folSaved As MAPIFolder
Dim olmMessage As MailItem
Dim olaAttachment As Attachment
Dim strTemp As String
Dim strDestination As String
Dim strFilePath As String
Dim appExcel As Object
Dim wbkAttachment As Object
Set folInbox = Session.GetDefaultFolder(olFolderInbox)
Set folSaved = folInbox.Folders.Item("Saved")
strTemp = Environ("Temp")
strDestination = strTemp
Set appExcel = CreateObject("Excel.Application")
For Each olmMessage In folSaved.Items
If olmMessage.UnRead = True Then
olmMessage.UnRead = False
If olmMessage.Attachments.Count > 0 Then
For Each olaAttachment In olmMessage.Attachments
With olaAttachment
strFilePath = strTemp & "\" & .FileName
.SaveAsFile (strFilePath)
Set wbkAttachment = appExcel.workbooks.Open(strFilePath)
With wbkAttachment
.SaveAs strDestination & "\" & _
.Worksheets("Sheet1").Range("B5").Value
.Close
End With

Kill strFilePath
End With
Next olaAttachment
End If
End If
Next olmMessage
appExcel.Quit
End Sub


Enjoy.
Scott

Hey, thanks for your help, but I'm getting this runtime error. Then when I open up excel, a worksheet called "2008.xls" (The temp file?) shows up.

The value in the cell is "10/08/2008" I am guessing that the forward slashes in the cell value has something to do with it.

So perhaps it's not saving the temp file correctly?

http://i38.tinypic.com/2ceoiub.jpg

[Demosthine]

Good Morning.

You are absolutely correct that the slashes in the date are the cause of your error. In Windows, you can not use any of the following in your file names: / \ : * ? " < > | Any time it comes across the slashes, it takes the text inbetween them and thinks that's the directory.

To solve this problem easily, you can use several methods. Using the Format Function if you know it'll always be a date, or the Replace Function otherwise.

If the Cell's Value will always be a date, I would use the Format Function to re-format the date. First, I'd recommend having the year always come first, followed by the month and finally the day. This makes sorting and finding files so much easier. i.e. yyyy-mm-dd


.SaveAs strDestination & "\" & _
Format(.Worksheets("Sheet1").Range("B5").Value, "yyyy-mm-dd" & _
".xls"


If you are not sure what the file name will be, I would create a separate function to eliminate all of the invalid characters for filenames.


Public Function FixFilename(Filename As String) As String
Dim strInvalids() As Variant
strInvalids = Array("/", "\", ":", "*", "?", """", "<", ">", "|")
For intIndex = 0 To UBound(strInvalids) - 1
Filename = Replace(Filename, strInvalids(intIndex), "", 1, -1, vbTextCompare)
Next intIndex

FixFilename = Filename
End Function


I hope this helps.
Scott