Hi Everyone,
I have a VBA to save the attachment from unread emails one by one on shared mailbox. but this VBA looping only 2 times. (It will check and save the attachments with 2 mails only). I want to save the attachments from all the unread emails on shared mailbox. can anyone help me to fix this issue.
Thanks in Advance
I have a VBA to save the attachment from unread emails one by one on shared mailbox. but this VBA looping only 2 times. (It will check and save the attachments with 2 mails only). I want to save the attachments from all the unread emails on shared mailbox. can anyone help me to fix this issue.
Code:
Option Explicit
Sub saveattachment()
Dim ol As Outlook.Application
Dim ns As Outlook.NameSpace
Dim fol As Outlook.Folder
Dim folco As Outlook.MAPIFolder
Dim i As Object
Dim mi As Outlook.MailItem
Dim at As Outlook.Attachment
Dim fso As Scripting.FileSystemObject
Dim dir As Scripting.Folder
Dim dirName As String
Dim dirpath As String
Set fso = New Scripting.FileSystemObject
Set ol = New Outlook.Application
Set ns = ol.GetNamespace("MAPI")
'Set fol = ns.Folders(1).Folders("inbox")
Set fol = ns.Folders("local mailbox").Folders("Inbox")
Set folco = ns.Folders("local mailbox").Folders("Deleted Items")
' 'Set fol = ns.Folders("Shared folder").Folders("Inbox")
' 'Set folco = ns.Folders("Shared folder").Folders("Deleted Items")
'ns.Folders(1).Folders(1) ns.Folders("Personal Folders").Folders("Deleted Items")
For Each i In fol.Items
If i.Class = 43 Then
Set mi = i
' If mi.UnRead = True Then
If mi.Attachments.Count > 0 Then
'Debug.Print mi.SenderName, mi.ReceivedTime, mi.Attachments.Count
dirName = _
"C:\users\Input\" & _
Format(mi.ReceivedTime, "DD-mm-YYYY hh-nn-ss ") & _
Left(Replace(mi.Subject, ":", ""), 10)
' If fso.FolderExists(dirName) Then
' Set dir = fso.GetFolder(dirName)
dirpath = "C:\users\Input\"
' Else
' Set dir = fso.CreateFolder(dirName)
' End If
For Each at In mi.Attachments
If InStr(at.DisplayName, ".xlsx") Then
'Debug.Print vbTab, at.DisplayName, at.Size
' at.SaveAsFile dirpath & "\" & at.Filename & "\" & Format(Date, "ddmmyyyy") & "_" & at.DisplayName
at.SaveAsFile dirpath & "\" & Format(Date, "dd-mm-yyyy") & "_" & at.DisplayName
mi.Move folco
' mi.UnRead = False
End If
Next at
End If
End If
' End If
Next i
End Sub