Created
June 16, 2020 02:45
-
-
Save TyeolRik/cde877769722c57b41a6e4edb95b9ac2 to your computer and use it in GitHub Desktop.
Outlook Automatic Download all Attachments
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Public 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 = CreateObject("WScript.Shell").SpecialFolders(16) | |
On Error Resume Next | |
' Instantiate an Outlook Application object. | |
Set objOL = Application | |
' Get the collection of selected objects. | |
Set objSelection = objOL.ActiveExplorer.Selection | |
' The attachment folder needs to exist | |
' You can change this to another folder name of your choice | |
' Set the Attachment folder. | |
strFolderpath = strFolderpath & "\OLAttachments\" | |
' Check each selected item for attachments. | |
For Each objMsg In objSelection | |
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 | |
Next | |
ExitSub: | |
Set objAttachments = Nothing | |
Set objMsg = Nothing | |
Set objSelection = Nothing | |
Set objOL = Nothing | |
End Sub |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
This codes should be in Microsoft Outlook Visual Basic (Alt+F11 in windows)
You can see all files in C:\Users\{Your User Name}\Documents\OLAttachments