Outlook 2010 Saving attachment from outlook in My Documents

Veeru106

Member
Outlook version
Outlook 2010 64 bit
Email Account
Outlook.com (as MS Exchange)
Hi, I am new in this forum..... I have code where by clicking on mail and using VBA..i can save that email attachment in my documents in that particular folder(For T&E and For President).......it is working fine but what I trying to do is .....saving attachment but before that create a folder according to the email date...let's say if email date is 06/05/2017 then is should create a June month folder and then save attachment. Please suggest



Dim strFolder As String

Public Sub SaveToFolderBob()
strFolder = "For T&E"
SaveAttachments
End Sub

Public Sub SaveToFolderJim()
strFolder = "For President"
SaveAttachments
End Sub

Private Sub SaveAttachments()
Dim objOL As Outlook.Application
Dim objMsg As Outlook.MailItem 'Object
Dim objAttachments As Outlook.Attachments
Dim objSelection As Outlook.Selection
Dim i As Long
Dim lngCount As Long
Dim strFile As String
Dim strFolderpath As String
Dim strDeletedFiles As String

' Get the path to your My Documents folder
strFolderpath = Environ("HOMEDRIVE") & Environ("HOMEPATH") & "\Documents"
Debug.Print strFolderpath
On Error Resume Next

' The attachment folder needs to exist
' You can change this to another folder name of your choice

' Set the Attachment folder.
strFolderpath = strFolderpath & "\" & strFolder & "\"
Debug.Print strFolderpath

Set objOL = Outlook.Application
Set objMsg = objOL.ActiveExplorer.Selection.Item(1)

Set objAttachments = objMsg.Attachments
lngCount = objAttachments.Count

If lngCount > 0 Then

' Use a count down loop for removing items
' from a collection. Otherwise, the loop counter gets
' confused and only every other item is removed.

For i = lngCount To 1 Step -1

' Get the file name.
strFile = objAttachments.Item(i).FileName

' Combine with the path to the Temp folder.
strFile = strFolderpath & strFile

' Save the attachment as a file.
objAttachments.Item(i).SaveAsFile strFile

Next i
End If

ExitSub:

Set objAttachments = Nothing
Set objMsg = Nothing
Set objSelection = Nothing
Set objOL = Nothing
End Sub
 

Diane Poremsky

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
You need to use the folder scripting. See Saving All Messages to the Hard Drive Using VBA - this is the part that does the magic - you just need to get the date and format it.
If Not FSO.FolderExists(StrFolderPath) Then
FSO.CreateFolder (StrFolderPath)
End If

AFAIK, you can't create folders & subfolders at one - you'd need to loop to create more than one folder in the path. So, if all mail goes into subfolders named with the date, it will work, but if you need to create a folder for their name then one for the date, you need to check for the name and create it then check for the date and create it, if needed.
 

Veeru106

Member
Outlook version
Outlook 2010 64 bit
Email Account
Outlook.com (as MS Exchange)
Thanks Diane...one thing more...can you please guide me how can I save my attachments into any other share dive apart fro my documents. How can I find path and include in code to save it in that particular sharedrive rather than my documents. Thanks in advance...
 

Diane Poremsky

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
Basically, you just change this line to point to the new path -
strFolderpath = Environ("HOMEDRIVE") & Environ("HOMEPATH") & "\Documents"
to the new path
strFolderpath = "D:\Data"

FWIW, if you have the folder in strFolder path, I'd put the trailing slash there too:

strFolderpath = "D:\Data\"

then later, use
strFolderpath = strFolderpath & strFolder & "\"
 

Veeru106

Member
Outlook version
Outlook 2010 64 bit
Email Account
Outlook.com (as MS Exchange)
\\us1.1corp.org\agir\Departments\Accounting\Inf\Veeru
This is my share drive path...I have mentioned this path instead of Environ("HOMEDRIVE") & Environ("HOMEPATH") & "\Documents" as you mentioned above but it is not saving attachment nor it is giving any error message. thanks
 

Diane Poremsky

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
outlook can have problems with network drives - it takes too long to connect to them or the credentials aren't properly passed. Can you map the drive or sync it using onedrive?

what is the file type? we might be able to open it and save it that way - i use this code in word to save the current doc to sharepoint - but it should only work in word and excel.
ActiveDocument.SaveAs2 FileName:= _
"https://cdolive.sharepoint.com/" & Trim(sName) & ".docx" _
, FileFormat:=wdFormatXMLDocument, LockComments:=False, Password:="", _
AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False, _
EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, SaveFormsData _
:=False, SaveAsAOCELetter:=False, CompatibilityMode:=15
 

Veeru106

Member
Outlook version
Outlook 2010 64 bit
Email Account
Outlook.com (as MS Exchange)
I am using normal excel files in above share drive.......what your code is all about....and where do I need to paste it...in outlook?
 

Diane Poremsky

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
that is word code - if the files are in excel it will need to be tweaked a little.

The code to save is
ActiveWorkbook.SaveAs Filename:= _
"https://cdolive-my.sharepoint.com/Book1.xlsm" _
, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False

but you need to reference exchange in outlook to make it work. (not hard to do).
 

Mg32083

New Member
Outlook version
Outlook 2016 64 bit
Email Account
Exchange Server
I am also very new to this VBA stuff and this forum. Can this code be used in Outlook 2016?? I am trying to do something very similar. I need to be able to save all attachments from an email sub folder either to one Excel spreadsheet that compiles them or to a folder on my desktop. All of the attachments are .xls and have the same name "To be Returned" no individual identifiers though. If possible can the code only save attachments from emails that came in "today" no matter what day I run it "i.e. I run it on 7/20 it only pulls from emails I received on 7/20 and so on". Any help or guidance is greatly appreciated.

What I'm Using:
Outlook 2016
Microsoft Exchange Email Acct
Sub Folder "To be Returned"
Excel 2016
Skill level extremely new
 

Diane Poremsky

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
Sorry I was on vacation last week... so you just want to save the attached file to a folder on your hard drive? Not a problem. If you are running the macro manually, it can run on the selected message, or if you don't want to find the message but save the most recent file, the macro can search for it and save it.

The macro at Save and Rename Outlook Email Attachments will save and rename attachments on the selected message but the rename part can be removed by deleting the 4 or 5 lines between
objAtt.SaveAsFile file and Next. They all handle the rename.
 

Veeru106

Member
Outlook version
Outlook 2010 64 bit
Email Account
Outlook.com (as MS Exchange)
Thanks Diane for your valuable suggestion....I checked the link you sent......and got my answer, in mean while I also looking for some code where I can send automatically mails on every Monday at 4 pm....this kind of recurring mails or reminder mails I need to send every Monday and I want to be sent via code rather I do it manually....any suggestion will be appreciated
 

Veeru106

Member
Outlook version
Outlook 2010 64 bit
Email Account
Outlook.com (as MS Exchange)
Thanks Diane for revert.....I have checked the link and found it very useful...except one thing...code is working fine if I mentioned objMsg.Display instaed of objMsg.Send...
in objMsg.Send it is showing Microsoft doesn't recognize it...not sure why...any suggestion please
 

Veeru106

Member
Outlook version
Outlook 2010 64 bit
Email Account
Outlook.com (as MS Exchange)
Hey Diane...do we have any update on above issue... please
 

Diane Poremsky

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
Does the line change color or what happens when its set to .Send? Any error messages?
 

Similar threads

Top