How to save emails to a specific folder on a network automatically using a macro

Status
Not open for further replies.

nathandavies

Member
Outlook version
Outlook 2010 64 bit
Email Account
Exchange Server
I have seen a thread this morning "Save Emails on Hard Drive" which interested me I was wondering if this code can be changed at all to complete the following?

1. When the macro is run a input box appears for a string of text to input the location of the folder on a server. IE Project Number
2. When the project number is inputted the macro will search through our server “P:\Group\JOBDATA” or “P:\Group\QUOTATION" and find the folder and save any incoming emails to a specific folder “Email.In” within the “Correspondence” Folder and “Email.Out” for outgoing emails.

I know this might be asking a lot but if anyone can help that would be greatly appreciated!!


Sub SaveMessages()

'Declaration
Dim myItems, myItem As Object
Dim myOrt As String
Dim myOlApp As New Outlook.Application
Dim myOlExp As Outlook.Explorer
Dim myOlSel As Outlook.Selection
Dim FindTerm(13)

'Set invalid characters to replace
FindTerm(0) = "*"
FindTerm(1) = "@"
FindTerm(2) = "\"
FindTerm(3) = "("
FindTerm(4) = ")"
FindTerm(5) = "["
FindTerm(6) = "]"
FindTerm(7) = "?"
FindTerm(8) = "<"
FindTerm(9) = ">"
FindTerm(10) = "!"
FindTerm(11) = "{"
FindTerm(12) = "}"
FindTerm(13) = ":"

'Ask for destination folder
myOrt = InputBox("Destination", "Save Attachments", "P:\")

On Error Resume Next

'work on selected items
Set myOlExp = myOlApp.ActiveExplorer
Set myOlSel = myOlExp.Selection

'for all items do...
For Each myItem In myOlSel

strdate = myItem.SentOn
newdate = Format(strdate, "yyyymmddhhmm")
strname = newdate & "-" & myItem.Subject & ".msg"

For i = 1 To 13
newstr = Replace(strname, FindTerm(i), " ")
strname = newstr
Next
myItem.SaveAs myOrt & newstr
myItem.Delete

Next

'free variables
Set myItems = Nothing
Set myItem = Nothing
Set myOlApp = Nothing
Set myOlExp = Nothing
Set myOlSel = Nothing

End Sub
 

Diane Poremsky

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
#1 is possible, easy actually. #2 should be easy - sending the mail to the specific folder or creating the folder if it doesn't exist is easy, especially if it knows to use the Job folder or the quote folder. I don't have a macro that searches the hard drive for a folder.

The two macros on this page will save selected message and messages as they are sent. changing the folder path and inserting an input dialog to get the name are nothing.
 

nathandavies

Member
Outlook version
Outlook 2010 64 bit
Email Account
Exchange Server
thanks for your help, i'm very new to VBA so having difficulties with the code. can you point me in the right direction of a thread where it might have already been completed.
 

Andres B

Member
Outlook version
Outlook 2013 64 bit
Email Account
Exchange Server
I'm also working on a similar project but mine has to actually download emails with an exact date or even within a date range if that's possible. the following is the code i have and it works but my issue is when outlook looks at the "received date" or the email it finds a random date and instead of increasing it does it in decreasing order.


Public Sub SaveAttachments()
Dim OlApp As Outlook.Application
Dim Inbox As MAPIFolder
Dim Item As Object
Dim ItemAttachments As Outlook.Attachments
Dim ItemAttachment As Object
Dim ItemAttCount As Long
Dim strFolderpath As String
Dim strFileName As String
Dim Counter As Long
Dim ItemsCount As Long
Dim ItemsAttachmentsCount As Long
Dim SaveFolder As String
Dim FileName As String
Dim searchDate As String, searchDate2 As String
Dim RcvDate As Date, SrchDate As Date

'chose a folder to save the attachments in
SaveFolder = BrowseForFolder("Select the folder you will like to save the attachments to.")
If SaveFolder = vbNullString Then Exit Sub

'input a date to search
searchDate = InputBox("Please enter a previous date to search from (mm/dd/yyyy)")
If searchDate = vbNullString Then Exit Sub

'searchDate2 = InputBox("to which date (mm/dd/yyyy/)")
'If searchDate2 = vbNullString Then Exit Sub


'convert string to date
SrchDate = CDate(searchDate)



' Instantiate an Outlook Application object.
Set OlApp = CreateObject("Outlook.Application")
Set Inbox = OlApp.ActiveExplorer.CurrentFolder

Counter = 1
ItemsCount = 0
ItemsAttachmentsCount = 0

For Each Item In Inbox.Items

'get the email's received date
RcvDate = Item.ReceivedTime

'compare the date the user entered with the received date
If SrchDate = RcvDate Then

ItemsCount = ItemsCount + 1

For Each ItemAttachment In Item.Attachments
ItemsAttachmentsCount = ItemsAttachmentsCount + 1

' Get the file name.
FileName = SaveFolder & "\" & ItemAttachment.FileName

' Save the attachment as a file.
ItemAttachment.SaveAsFile FileName

' Combine with the path to the Attachments folder.
StrFile = ItemAttachment.FileName & Counter & "_" & StrFile

ItemAttachment.Delete

Counter = Counter + 1
Next ItemAttachment
End If

Next Item

ExitSub:

Set ItemAttachment = Nothing
Set ItemAttachments = Nothing
Set Item = Nothing
Set Inbox = Nothing
Set OlApp = Nothing
MsgBox "All Selected Folder Attachments Have Been Downloaded ..."
MsgBox "ItemsCount : " & ItemsCount
MsgBox "ItemsAttachmentsCount : " & ItemsAttachmentsCount
End Sub




Also Another issue i have with this one is that when there is multiple attachments in one email only the first one is removed and not the others. Hope it helps and i hope anyone can help me with my issues as well since i'm also fairly new to VBA.

Thanks
 

Michael Bauer

Senior Member
Outlook version
Outlook 2010 32 bit
Email Account
Exchange Server
1) See this example: http://www.vboffice.net/en/developers/how-many-appointments-do-you-have-today
It demonstrates how to sort the Items collection, and how to restrict for a certain date. Change the value for GetDefaultFolder to olFolderInbox, and replace the field names [start] and [end] by whatever you want to restrict for.

2) Since you remove items from the attachments collection, you need to loop backwards through it, which looks like this:
Code:
for i=count to 1 step-1
  'set attachment variable here
next
 

Andres B

Member
Outlook version
Outlook 2013 64 bit
Email Account
Exchange Server
1) See this example: http://www.vboffice.net/en/developers/how-many-appointments-do-you-have-today
It demonstrates how to sort the Items collection, and how to restrict for a certain date. Change the value for GetDefaultFolder to olFolderInbox, and replace the field names [start] and [end] by whatever you want to restrict for.

2) Since you remove items from the attachments collection, you need to loop backwards through it, which looks like this:
Code:
for i=count to 1 step-1
  'set attachment variable here
next

thanks, i tried that and its working now when i input a date to select emails for that date i used the same method but the problem now became that when i input a date that is 3 months back or 5 months back the macro runs but it doesn't extract the attachments form these emails. Do you know of any way why it is doing it?
 

Michael Bauer

Senior Member
Outlook version
Outlook 2010 32 bit
Email Account
Exchange Server
It works for some dates, and it doesn't for other dates? Check if the Restrict function returns any item at all.
 

Andres B

Member
Outlook version
Outlook 2013 64 bit
Email Account
Exchange Server
It works for some dates, and it doesn't for other dates? Check if the Restrict function returns any item at all.
It's getting the same date but i think the problem is that now instead of item.receivedtime i'm using item.senton because once i put in the code for i = inbox.items.count 1 step to -1 the item.receivedtime property no longer is recognized.
 

Michael Bauer

Senior Member
Outlook version
Outlook 2010 32 bit
Email Account
Exchange Server
The kind of loop you're using has no effect on which properties are available. I guess you aren't setting the item variable in each loop.
 

Andres B

Member
Outlook version
Outlook 2013 64 bit
Email Account
Exchange Server
The kind of loop you're using has no effect on which properties are available. I guess you aren't setting the item variable in each loop.
The item variable is being set inside of the loop since i can use item.senton but nor item.receivedtime below is the loop in the code with the new requirements that were presented to me recently. Please let me know if you see where the problem might be happening or if you have any suggestions on improving the code. Thanks.


For i = Inbox.Items.Count To 1 Step -1

Set Item = Inbox.Items(i)
'i = 0

RcvDate = Format(Item.SentOn, "Short Date")

If RcvDate <= SrchDate Then

If SrchDate = RcvDate Then

For x = Item.Attachments.Count To 1 Step -1

Set Attach = Item.Attachments(x)

FileName = SaveFolder & "\" & Attach.FileName
Attach.SaveAsFile FileName
StrFile = Attach.FileName & ";" & StrFile
Attach.Delete

If Item.BodyFormat <> olFormatHTML Then
Item.Body = "The file(s) removed were: " & StrFile & vbCrLf & Item.Body
Else
Item.HTMLBody = "" & "The file(s) removed were: " & " " & StrFile & "<br><br>" & Item.HTMLBody
End If

Item.Save
StrFile = ""

Next x

Else
Exit Sub
End If
End If
Next i
 

Andres B

Member
Outlook version
Outlook 2013 64 bit
Email Account
Exchange Server
So what does mean?
I was thinking maybe that had to do something with the issues i'm having since item.senton is being used instead of the actual received time(Item.ReceivedTime) of the email itself. I'm just basing this on assumptions not really sure if it is the reason.
 

Michael Bauer

Senior Member
Outlook version
Outlook 2010 32 bit
Email Account
Exchange Server
I'm sorry, I don't understand what issues you're talking about.
 

Andres B

Member
Outlook version
Outlook 2013 64 bit
Email Account
Exchange Server
I'm sorry, I don't understand what issues you're talking about.
The issues that i'm having is that when the for loop starts it seems to be starting on random emails picking random dates.. for instance if my last received e-mail is 12/09/2014 it will either pick that date and loop a few times and end up in a date like 12/03/2013 in only a few loops. It seems to just be choosing random email dates and searching from there.
 

Michael Bauer

Senior Member
Outlook version
Outlook 2010 32 bit
Email Account
Exchange Server
Ok, see my first reply, which points to an example for how to sort the Items collection. You need to sort it to get the items in the order you want.
 
Status
Not open for further replies.
Thread starter Similar threads Forum Replies Date
Y Open and Save Hyperlink Files in multiple emails Outlook VBA and Custom Forms 9
I Outlook 2016 64bit - on receipt convert emails into PDF and save Outlook VBA and Custom Forms 2
E Outlook 2016 and Numerous Prompts to Save Emails Using Outlook 3
B Auto Save of Attachments from Multiple Emails and forward attachments to user group Outlook VBA and Custom Forms 1
H Save Draft Emails Using Outlook 3
J Save emails in the IMAP sent folder Using Outlook 2
C Save as HTML for multiple emails Using Outlook 1
M Outlook doesn't save sent emails Using Outlook 1
C Outlook 2010 &amp; windows 7 - WILL NOT SAVE emails on the server. Using Outlook 1
E Change Default Directory when attach or save files of emails Using Outlook 1
E Re: How to copy Hotmail personal folder with my emails onto my Desktop so I can save the emails and Using Outlook 1
K Outlook doesn't save outgoing emails. Using Outlook 2
S In Microsoft Outlook 2003 I have a Adobe PDF icon, to convert emails to pdf and then save them in the correct folder/file and it is not working anymor Using Outlook 1
S In Microsoft Outlook 2003 I have a Adobe PDF icon, to convert emails to pdf and then save them in the correct folder/file and it is not working anymor Using Outlook 1
A Save deleted emails Using Outlook 2
J Code to Save Email as an .MSG to Directory when Emails Arrive Outlook VBA and Custom Forms 4
K Re: save certain emails from inbox to network drive with a macro Outlook VBA and Custom Forms 1
D Prevent popup of "Do you want to save changes?" when closing after opening an appointment to view Outlook VBA and Custom Forms 2
A Unable to save recurring Meeting to Documents folder due to error Using Outlook 2
M Outlook 2013 Script Assistance - Save Opened Link with Subject Added Outlook VBA and Custom Forms 1
R Use an ItemAdd to Save Attachments on Arrival Outlook VBA and Custom Forms 0
W Outlook Calendar does not save view any longer! Using Outlook 3
S automate save the .xlxs file to share Network Using Outlook 1
S save email from excel Outlook VBA and Custom Forms 1
9 Outlook 2016 How to save an Outlook attachment to a specific folder then delete the email it came from? Using Outlook 1
O Save attachments using hotkey without changing attributes Outlook VBA and Custom Forms 1
geofferyh Cannot get Macro to SAVE more than one message attachment??? Outlook VBA and Custom Forms 5
N Open & Save VBAProject.Otm using VBA Code Outlook VBA and Custom Forms 1
R VBA | Chosing path to save file Outlook VBA and Custom Forms 1
W Save and rename outlook email attachments to include domain name & date received Outlook VBA and Custom Forms 4
V Change default default save location to Quick Access Using Outlook 1
W Save Outlook attachment in network folder and rename to current date and time Outlook VBA and Custom Forms 18
C Change default "Save Sent Item To" folder Outlook VBA and Custom Forms 9
C Outlook - cannot save subject line changes Using Outlook 2
J Save E-mail attachments in a specific folder Outlook VBA and Custom Forms 0
V VB script code to save a specific email attachment from a given email Outlook VBA and Custom Forms 14
C Auto save outlook attachments when email is received Outlook VBA and Custom Forms 1
N editing drafts - won't let me save Using Outlook 12
nathandavies Email Details to Excel & Save as .MSG on one macro - combination of 2 macros Outlook VBA and Custom Forms 3
C Need VBA code to automatically save message outside outlook and add date Outlook VBA and Custom Forms 1
D Save Sent Item to Using Outlook 0
Diane Poremsky Save Selected Email Message as .msg File New Slipstick.com Articles 11
Diane Poremsky Export (Save) Outlook Contact photos New Slipstick.com Articles 0
Diane Poremsky Save Messages and Attachments to a New Folder New Slipstick.com Articles 0
B Delete/replace old files and save new attachments Using Outlook 1
Diane Poremsky Save Outlook Email as a PDF New Slipstick.com Articles 0
Diane Poremsky Edit and Save Outlook's Read-Only Attachments New Slipstick.com Articles 0
Diane Poremsky Save Attachments to the Hard Drive New Slipstick.com Articles 2
B VBA Help Email that will save as draft and send as attachment Outlook VBA and Custom Forms 3
C Save Subject of Received Email as a String Outlook VBA and Custom Forms 1
Similar threads


















































Top