1。 按 其他 + F11 键以打开“ Microsoft Visual Basic应用程序”窗口。
2。 点击 插页 > 模块，然后将以下VBA脚本粘贴到新打开的“模块”窗口中。
VBA：自动将Outlook附件保存到某个文件夹
Public Sub SaveAttachmentsToDisk(MItem As Outlook.MailItem)
Dim oAttachment As Outlook.Attachment
Dim sSaveFolder As String
sSaveFolder = "C:\Users\DT168\Documents\outlook-attachments\"
For Each oAttachment In MItem.Attachments
oAttachment.SaveAsFile sSaveFolder & oAttachment.DisplayName
Next
End Sub
I executed the VBA + Rule option and it seemed to work perfectly. However, it recently stopped working with no errors. The rule is set to read the subject line, move to a certain folder if there is a certain subject, and then run the script. I know the trigger is working in the rule because the first action (move to folder) is working as it should.
Any idea why the rule trigger would work, but the documents are no longer being saved?
Things I have tried/checked:
-The file path is correct
-I added delays in various spots in the vba using application.wait
-outlook has been shutdown and re-opened, and so has my laptop
(disclosure: I am a bit of a VBA newbie, but have beginner level coding knowledge)
Hi I have a problem. I can't find "run a script" command in second step dialog window while creating the rule :/ I have the Outlook2016, any ideas how to find it or turn it on ?
Public Sub SaveAttachmentsToDisk(MItem As Outlook.MailItem) Dim oAttachment As Outlook.Attachment Dim sSaveFolder As String sSaveFolder = "C:\Users\DT168\Documents\outlook-attachments\" For Each oAttachment In MItem.Attachments oAttachment.SaveAsFile sSaveFolder & oAttachment.DisplayName Next End Sub
Everything works great but what if I have a number of attachments in the email and I only want to save the excel and pdf files which are attached and not all the files attached to the email? Does someone can help? Much appreciated.
I got the script to run, everything works, but is there anyway to prevent the original email from being deleted? It is going directly into my "permanently deleted" files. I'd like the emails to stay right where they are rather than being deleted.
Public Sub SaveAttachmentsToDisk(MItem As Outlook.MailItem) Dim oAttachment As Outlook.Attachment Dim sSaveFolder As String MsgBox "E:\Dropbox\Apps\Attachments" & F sSaveFolder = "E:\Dropbox\Apps\" & Format(Now(), "dd.mm_hh.mm.ss") For Each oAttachment In MItem.Attachments oAttachment.SaveAsFile sSaveFolder & oAttachment.DisplayName Next End Sub
Hi Shilpa. At colabel we are developing a no-code solution that can automatically categorize and store your attachments into folders. We're currently looking for qualified beta users willing to test our solution for free. In case you think we might help you, just send me an email at filippo@colabel.com
Hi sipho,
If you enable the Auto Save Attachments or Auto Detach Attachments feature of Kutools for Outlook, they will save or detach attachments automatically from new incoming emails only when Outlook is running,
How can I save this with a timestamp in the file name? The files I receive via e-mail always have the same name and the newer file overrides the previous one.
Hi Guil,
If you use the Detach All (Attachments) of Kutools for Outlook, you can specify to place the attachments into subfolders which are named as message subject-receive time.
Hello, this code is running but MItem.Attachments.Count shows 0. When i try in debug mode watch this variable it reread and value shows more than 1. Help please. Why the variable didn't read in automatic mode?
Hi Krishnakant,
In this article, I have introduced the method to restore the Run a script option in Outlook. Hope it can help you.
https://www.extendoffice.com/documents/outlook/4640-outlook-rule-run-a-script-missing.html
Hi,
I have retored the Run a script option in Outlook. But it still doesen't work. the message error is "This rule is not available in the current mode". Can you help me please?
Public Sub SaveAttachmentsToDisk(MItem As Outlook.MailItem)
Dim oAttachment As Outlook.Attachment
Dim sSaveFolder As String
sSaveFolder = "D:\Adarsh\My\Payslips\" & Year(Date)Format(Date, "DD") & Format(Date, "Mmm")
For Each oAttachment In MItem.Attachments
oAttachment.SaveAsFile sSaveFolder & oAttachment.DisplayName
Next
End Sub
My Computer will only download the attachments when I run the rule manually. it doesn't automatically download the attachments when new emails arrive. Is that how it is supposed to be or could I have something set up wrong?
Hello, I tried downloading the attachments to a folder but the code doesn't seem to work.
Kindly Help.
Public Sub SaveAttachmentsToDisk(MItem As Outlook.MailItem)
Dim oAttachment As Outlook.Attachment
Dim sSaveFolder As String
sSaveFolder = "D:\Adarsh\My\Payslips\" & Year(Date)Format(Date, "DD") & Format(Date, "Mmm")
For Each oAttachment In MItem.Attachments
oAttachment.SaveAsFile sSaveFolder & oAttachment.DisplayName
Next
End Sub
In option 1, where am I supposed to hit ALT + F11? I tried with Outlook opened and it isn't working. Normal ALT + F11 does nothing, and ALT Gr + F11 opens my Intel HD Graphic Control Panel.
Can I save attachments from 1 category in my email box? I don't need all of them, so I need select it. I have trial version of Kutools and in Options I have just 3 tabs: General, Detach&save and Compress. I saw on the page, that you have tab Filter. So Can I select and make settings from which category to save attachments?
1) This software not only saves the attachments but also the email message itself as a png file correct?
2) This software will let us save each new email in a new subfolder if we set it up correct?
3) This software will let us set up filters to control which emails get sent to dropbox and which ones are passed on correct?
Hi, if you need to manage widely the attachments this solution is the best, but if you own a Dropbox account there are some email providers that automatically upload every attachment to Dropbox account. It means that you get the attachment in dropbox folder even if you hadn't read the email. I use servermx.com because they did a customization about the Dropbox path where I need to put the attachments.
After having gone through all the steps it does work. The only thing is that while it saves the message as a png file, I would also like the script to actually go to the link in the message and download the data from there. Any good ideas how to extend the script?
I have implemented the rule and the macro as explained. I have even added a msgbox line to make sure that all was ok and it is as the mail subject is properly displayed but the attachement is not saved
Public Sub SaveAttachmentsToDisk(MItem As Outlook.MailItem)
Dim oAttachment As Outlook.Attachment
Dim sSaveFolder As String MsgBox "Mail Subject: " & MItem.Subject
sSaveFolder = "C:\Users\regis\Documents\Attach\"
For Each oAttachment In MItem.Attachments
oAttachment.SaveAsFile sSaveFolder & oAttachment.DisplayName
Next
End Sub
Hi, had a problem with it as well. For me, it were the Outlook settings under Trust Centre. All macros had been disabled. Once I enabled the macros to run on outlook, the script appeared to run and save the file.
Hi Regis,
It's hard to figure out the problem. What about trying Kutools for Outlook’s Automatically Detach feature? This feature only requires you to check one options, and all attachments will be automatically downloaded to the specified folder in futre!
Hi Lahiri,
Kutools for Outlook has released the Detach All feature, and you can easily save all attachments in the specified mail folder by the new Detach All feature.
In the lastest version of Outlook, the "run a script" option is removed from the Outlook rules. You can follow the method in this article to restore it: https://www.extendoffice.com/documents/outlook/4640-outlook-rule-run-a-script-missing.html
Hello, i want to save my pdf documents from outlook inbox into a specific folder,i want my attachment to be saved as pdf files with its name so that when i open the documents in my webside it is written "qoute document" exactly the way it has been saved. or save the documents with subject line and email body.Does your application support the mentioned above? thanks for your respond in advance
Hi,
Do you mean attachment names are same? If attachment names are same, they won’t not be replaced, but be named as filename(1), filename(2), filename(3)… in the destination folder.
Using the Outlook 2010 method which works brilliantly, I now need to be able to only save certain attachment types, such as PDF and JPG. I have no VBA knowledge can someone tell me what to add to do this, I have tried a few changes to the code with no luck
Public Sub SaveAttachmentsToDisk(MItem As Outlook.MailItem)
Dim oAttachment As Outlook.Attachment
Dim sSaveFolder As String
sSaveFolder = "U:\Attachments\"
For Each oAttachment In MItem.Attachments
oAttachment.SaveAsFile sSaveFolder & oAttachment.DisplayName
Next
End Sub
Got there in the endPublic Sub SaveAttachmentsToDisk(MItem As Outlook.MailItem)
Dim oAttachment As Outlook.Attachment
Dim sSaveFolder As String
sSaveFolder = "U:\Attachments\"
For Each oAttachment In MItem.Attachments
If UCase(Right(oAttachment.FileName, 3)) = "PDF" Or UCase(Right(oAttachment.FileName, 3)) = "TIF" Then _
oAttachment.SaveAsFile sSaveFolder & oAttachment.DisplayName
Next
End Sub
Hi,
Below VBA script will save all PDF attachments from mail folders. For saving from a certain folder, you can specify the folder when manually running the rule.
Public Sub SaveAttachmentsToDisk(EmailItem As Outlook.MailItem)
Dim xAttachment As Outlook.Attachment
Dim xDotPos As Integer
Dim xSavePath As String, xFileType As String
xSavePath = "C:\Users\DT168\Documents\outlook-attachments\"
For Each xAttachment In EmailItem.Attachments
xDotPos = InStrRev(xAttachment.DisplayName, ".")
xFileType = Mid(xAttachment.DisplayName, xDotPos, Len(xAttachment.DisplayName) - xDotPos + 1)
If xFileType = ".pdf" Then
xAttachment.SaveAsFile xSavePath & xAttachment.DisplayName
End If
Next
End Sub
Got it up and running no big issues. But when testing I noted one email with an attached PDF no matter what I do the script will not save the file. It is not the file name, it is not the subject, it is not who it came from. I can only think its something in the body of the email. Any ideas what would stop a file saving when all others pretty much exactly the same work?
I had trouble with this but I got from another resource that you have to allow all macros to run in Outlook. You can achieve this by following the following steps:
1 - Goto File -> Trust Center then click on Trust Center Settings on the right
2 - Macro Settings -> Enable all macros
3 - Restart Outlook and then it should work
I am interested in the Auto Save Attachment feature, but 2 questions:
1. Can I activate this ONLY for a subfolder? I don't want this to run on every single email. Only emails that are redirected to a subfolder via an Outlook Rule.
2. When you say "detach", to me that implies the attachment is removed from the message permanently. I don't want to remove the attachment. I just want to download a copy of it to a folder. So which is it? Does your software remove the attachment or does it just save a copy?
Hi EC,
Thank you for your interesting in our software. 1. At present, the Auto Detach feature will save every attachment arriving in the Inbox folder by default, and the Detach feature will remove attachments and leave hyperlinks linking to the saved attachments.
2. Our development team is improving and enhancing both feature now. In the near future, users are entitled to auto detaching attachments by special criteria (such as color, flag), folders, etc.; and the detach feature will be enhanced to several sub-features, such as save attachments, delete attachments and leave hyperlinks, delete attachments, etc. Please be patient for the new version.
Hi! Did you finish with this project? I mean do you have new version which can do 1) and 2) steps? I need save attachments from 1 category in email box, I don't need all of attachments.
I want my attachments to be downloaded into (automaticall)y created date folders under my predefined folders. Example: I want all my Gsuite attachments and emails to download into an automatically created date folder (mm yyyy) under the folder Gsuite as with this google app https://chrome.google.com/webstore/detail/save-emails-and-attachmen/nflmnfjphdbeagnilbihcodcophecebc. Is it possible with Kutools? If not, can someone help me with a script?
Hi Casper,
Kutools can automatically create subfolder named as email subject, and all attachments in the specified email will be saved into this subfolder.
At present, our development team is optimizing the Detach All Attachments feature and Auto Detach All Attachments feature, and both features will be enhanced and efficient in future.
I have done all scripting to download the attachments from outlook mail and my script is working fine when i run it manually. I would like to automate the process using the Rule option. But i couldn't see my macro in the Rules Wizard window. I have enabled the below option in the registry too
HKEY_CURRENT_USER\Software\Microsoft\Office\16.0\Outlook\Security
DWORD: EnableUnsafeClientMailRules
Value: 1
But still i couldn't see my macro in the Rule Wizard list. My rule wizard list is empty but i have created the macro already and its manually working fine. I have to bring the macro in my Rules wizard to automate the process. Please help me if you have any ideas!
Hi, script works fine ... but want to extract the PDF's from a sub-folder, not from the main Inbox. Is there a way to change the script ?
Thank you in advance !
To post as a guest, your comment is unpublished.
· 4 years ago
Hi Eric,
Below VBA script will save all PDF attachments from mail folders. For saving from a certain folder, you can specify the folder when manually running the rule.
Public Sub SaveAttachmentsToDisk(EmailItem As Outlook.MailItem)
Dim xAttachment As Outlook.Attachment
Dim xDotPos As Integer
Dim xSavePath As String, xFileType As String
xSavePath = "C:\Users\DT168\Documents\outlook-attachments\"
For Each xAttachment In EmailItem.Attachments
xDotPos = InStrRev(xAttachment.DisplayName, ".")
xFileType = Mid(xAttachment.DisplayName, xDotPos, Len(xAttachment.DisplayName) - xDotPos + 1)
If xFileType = ".pdf" Then
xAttachment.SaveAsFile xSavePath & xAttachment.DisplayName
End If
Next
End Sub
Hello, Is there a VBA script for CSV attachment. I currently have report jobs that automatically goes into named folders in outlook I would now like for those files in the folders extract itself and go into the corresponding folders on my desktop. Hope this makes sense. Please Help! I am very new to VBA.
If the option for "Run a Script" is missing, it's because it's blocked by default now since a security update a few months ago. Look here for more information: https://www.slipstick.com/outlook/rules/outlook-2016-run-a-script-rules/
I try hard to setup the automatic download as described above by using VBA script but nothing has been saved in the target folder.
I tried this on Outlook 2007 and Outlook 2010, and also make sure the folder has all the necessary authorities. But still no single attachment has been saved. Can anyone help me on this?
I am setting up the script you have at the top of the page and it works OK, however, I would like to name the attachment being saved so that it overwrites the old one. What would I need to add to get this to happen? Thanks David
Hi, I must say its superb script, it resolved 80% of my work but still I have one issue. The attachments I receive is with new date and time-stamp on daily basis and I want to auto save these attachment but by removing the date/time stamp so that next time it will replace/overwrite and save new copy with same name.,Do not want every day attachments getting save with new date. instead same file needs to be replaced at same location.
Can Kutools be set up so that it only saves attachments from certain emails based on the subject? And can the same file be saved to multiple directories from a single email? We want to use this for report distribution instead of email.
Dim filepath As String filepath = Dir(sSaveFolder & oAttachment.DisplayName) If filepath = "" Then oAttachment.SaveAsFile sSaveFolder & oAttachment.DisplayName Else oAttachment.SaveAsFile sSaveFolder & "1-" & oAttachment.DisplayName End if
and so on... play about with the code and let me know how you get on..
Public Sub SaveAttachmentsToDisk(MItem As Outlook.MailItem) Dim oAttachment As Outlook.Attachment Dim sSaveFolder As String sSaveFolder = "\\Dck-server-02\g\00 Uploads\" For Each oAttachment In MItem.Attachments oAttachment.SaveAsFile sSaveFolder & oAttachment.DisplayName Next End Sub
As you can see i have left the filename that is the attachment as the same for when it copies to the network drive. However, if multiple emails come through with the same filename for the attachment, the script then allows the most recent attachment to overwrite the previous attachment in the network folder. Is there an edit which i can input into the script which will append a "-1" "-2" "-3" etc... to the end of the attachment filename? So for example, if the attachment is named "inspection" and i get multiple that come through can i have them renamed to "inspection-1" "inspection-2" "inspection-3"
Hi, I have been trying to follow the steps as directed i selected all the above options but after selecting the "run a script" option and selecting the link "a script" I do not get the script in that dialogue box. Please help as soon as possible. Thanks!
指定目标文件夹以保存自动分离的附件；
