I have VBA code to automatically download (save) received mail attached files.
I need to make a condition to only download (save) .xlsx or .jpg files.
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
Simply use Select Case Statement
Dim FileType As String
For Each oAttachment In MItem.Attachments
FileType = LCase$(Right$(oAttachment.FileName, 4)) ' Last 4
Select Case FileType
Case "xlsx", ".jpg"
oAttachment.SaveAsFile sSaveFolder & oAttachment.DisplayName
End Select
Next
Related
An Outlook rule executes code every time an e-mail from a certain sender is received. It would automatically extract the PDF attachment from e-mails and put them into a specified folder.
We've been using it for a good 9 months.
From around 10/22 it crashes on the line For Each oAttachment In MItem.Attachments with Error 424 Object Required. in the DAKSave portion.
I have tried changing the folder to a local folder, same error. This error also occurs on different computers when I try using the code (including a computer which WAS able to use that specific code previously).
I have enabled EnableUnsafeClientMailRules in regedit.
Why isn't it working? Why was it working until now?
Public Sub SaveAttachmentsToDisk(MItem As Outlook.MailItem)
Dim oAttachment As Outlook.Attachment
Dim sSaveFolder As String
sSaveFolder = "S:\Fax\FAX AUTODUMP\"
For Each oAttachment In MItem.Attachments
oAttachment.SaveAsFile sSaveFolder & oAttachment.DisplayName
Next
End Sub
Sub DAKSave()
Dim oAttachment As Outlook.Attachment
Dim sSaveFolder As String
sSaveFolder = "S:\Fax\FAX AUTODUMP\"
For Each oAttachment In MItem.Attachments
oAttachment.SaveAsFile sSaveFolder & oAttachment.DisplayName
Next
End Sub
I'm open to suggestions that would accomplish the same automated task.
Your missing mail Item object, so try to work with ActiveExplorer.Selection.Item(1)
Option Explicit
Sub DAKSave()
Dim sSaveFolder As String
sSaveFolder = "S:\Fax\FAX AUTODUMP\"
Dim MItem As Outlook.MailItem
Set MItem = ActiveExplorer.Selection.Item(1)
Dim oAttachment As Outlook.attachment
For Each oAttachment In MItem.Attachments
oAttachment.SaveAsFile sSaveFolder & oAttachment.DisplayName
Next
End Sub
MItem is not passed as a parameter to the DAKSave sub. MItem is undefined in DAKSave. It is only available in the SaveAttachmentsToDisk sub.
I am trying to save attachments sent to a shared inbox to disk.
Public Sub CSD_SaveAttachmentsToDisk(MItem As Outlook.MailItem)
Dim oAttachment As Outlook.Attachment
Dim sSaveFolder As String
sSaveFolder = "C:\Users\user\Documents\"
For Each oAttachment In MItem.Attachments
Debug.Print ("saving...")
oAttachment.SaveAsFile sSaveFolder & oAttachment.DisplayName
Next oAttachment
End Sub
I'm using Outlook 2016, and have a rule which calls this script on all messages.
The messages aren't saved.
I'm trying to create a macro to download attachments from email I recieve and THEN delete the email.
I've got the macro to download the attachment, however, I don't know how to make it delete the email AFTER it downloads. When I use a rule, it deletes the email BEFORE downloading the attachment.
Here's what I've got:
Public Sub SaveAttachmentsToDisk(MItem As Outlook.MailItem)
Dim oAttachment As Outlook.Attachment
Dim sSaveFolder As String
sSaveFolder = "S:\Training and Curriculum\Staff Training Files\01 scans\"
For Each oAttachment In MItem.Attachments
oAttachment.SaveAsFile sSaveFolder & oAttachment.DisplayName
Next
End Sub
From what I can tell on that sub, you are passing MItem as the Outlook.MailItem object, which if I read your question correctly, is the item you want deleted. After your next in your loop, you should just be able to do MItem.Delete, which will delete that particular item after saving the file.
Public Sub SaveAttachmentsToDisk(MItem As Outlook.MailItem)
Dim oAttachment As Outlook.Attachment
Dim sSaveFolder As String
sSaveFolder = "S:\Training and Curriculum\Staff Training Files\01 scans\"
For Each oAttachment In MItem.Attachments
oAttachment.SaveAsFile sSaveFolder & oAttachment.DisplayName
Next
MItem.Delete 'This is the delete command
End Sub
Here is the MSDN documentation on MailItem.Delete - MSDN MailItem Delete Method
Public Sub SaveAttachmentsToDisk(MItem As Outlook.MailItem)
Dim oAttachment As Outlook.Attachment
Dim sSaveFolder As String
sSaveFolder = "C:\Users\axt112\Desktop\downloads\"
For Each oAttachment In MItem.Attachments
If oAttachment = "Checkpoint Volume and Movement Times*" Then oAttachment.SaveAsFile sSaveFolder & oAttachment.DisplayName
Next
End Sub
I'm using Outlook VBA code to save attachments with certain files on, into a specified folder. The rule runs this script, I don't see anything wrong with the rules, so I assume its the code.
It's weird because it worked fine last week, and I haven't changed anything. Do you guys see anything weird in the code?
Thanks.
You can't compare Outlook objects and strings in VBA. Most probably you expected to compare the DisplayName property of the Attachment class which returns a string representing the name, which does not need to be the actual file name, displayed below the icon representing the embedded attachment.
Public Sub SaveAttachmentsToDisk(MItem As Outlook.MailItem)
Dim oAttachment As Outlook.Attachment
Dim sSaveFolder As String
sSaveFolder = "C:\Users\axt112\Desktop\downloads\"
For Each oAttachment In MItem.Attachments
If oAttachment.DisplayName = "Checkpoint Volume and Movement Times*" Then
oAttachment.SaveAsFile sSaveFolder & oAttachment.DisplayName
Next
End Sub
or use the Like function:
Public Sub SaveAttachmentsToDisk(MItem As Outlook.MailItem)
Dim oAttachment As Outlook.Attachment
Dim sSaveFolder As String
sSaveFolder = "C:\Users\axt112\Desktop\downloads\"
For Each oAttachment In MItem.Attachments
If oAttachment.DisplayName Like "Checkpoint Volume and Movement Times*" Then
oAttachment.SaveAsFile sSaveFolder & oAttachment.DisplayName
Next
End Sub
You may find the Getting Started with VBA in Outlook 2010 article helpful.
Below is the script to download an attachment from mails in Outlook.
Public Sub SaveAttachmentsToDisk(MItem As Outlook.MailItem)
Dim oAttachment As Outlook.Attachment
Dim sSaveFolder As String
Dim dateFormat
dateFormat = Format(Now, "yyyy-mm-dd")
sSaveFolder = "c:\My\temp\"
For Each oAttachment In MItem.Attachments
oAttachment.SaveAsFile sSaveFolder & oAttachment.DisplayName
Next
End Sub
It downloads and stores in the path which is mentioned in my code only when attachment has different name.
For example, I received mail with attachment as 'List.csv'. With same name I received mail around 10 times.
But only one file (most recent one) got saved in the path.
Final code which works for me.
Public Sub saveAttachtoDisk(itm As Outlook.MailItem)
Dim objAtt As Outlook.Attachment
Dim saveFolder As String
Dim dt30daysAgo As Date
dt30daysAgo = DateAdd("d", -30, Now)
saveFolder = "c:\My\temp"
For Each objAtt In itm.Attachments
If itm.ReceivedTime > dt30daysAgo Then
If objAtt.FileName <> "list.csv" Then
objAtt.SaveAsFile saveFolder & "\" & objAtt.FileName
Else
objAtt.SaveAsFile saveFolder & "\" & itm.Subject & objAtt.FileName
End If
End If
Next
End Sub
You are just overwritting any existing file having the same name.
A very simple solution is to append the current date/time to the file name prior to save it.
To download attachments from the last 30 days only, add a check at the beginning of the procedure to compare the Mail's ReceivedTime with the date 30 days ago, and exit the procedure if received time is lower.
Public Sub SaveAttachmentsToDisk(MItem As Outlook.MailItem)
Dim oAttachment As Outlook.Attachment
Dim sSaveFolder As String
Dim dt30daysAgo As Date
dt30daysAgo = DateAdd("d", 30, Now)
If MItem.ReceivedTime < dt30daysAgo Then Exit Sub
sSaveFolder = "c:\My\temp\"
For Each oAttachment In MItem.Attachments
oAttachment.SaveAsFile sSaveFolder & Format(Now, "YYYY-MM-DD_hh-nn-ss") & oAttachment.DisplayName
Next
End Sub
But the check on ReceivedTime is not well placed, you should ideally do this this on the calling procedure.