Backup and recover physical and cloud-based servers and workstations, as well as endpoint devices that belong to remote users. Avoid downtime and data loss quickly and easily for Windows-based physical or public cloud-based workloads!
Public Sub SaveSelectedAttachments() On Error GoTo ErrorHandler Dim olns As Outlook.NameSpace Dim objMsg As Object Dim objAttachments As Outlook.Attachments Dim objSelectedItems As Outlook.Selection Dim f, i, j, k, counter As Integer Dim attPath, attFileName As String, strDesktop As String, strR As String Set olns = Application.GetNamespace("MAPI") Set objSelectedItems = olns.Application.ActiveExplorer.Selection strDesktop = "C:\Users\Jbryan\Desktop\SavedPDFS" msgfolder = strDesktop For Each objMsg In objSelectedItems k = k + 1 j = 0 If objMsg.Class = olMail Then Set objAttachments = objMsg.Attachments counter = objAttachments.Count If counter > 0 Then With objMsg strR = Format(.ReceivedTime, "Short Date") End With strR = Replace(strR, "/", "-", 1) For i = objAttachments.Count To 1 Step -1 j = j + 1 f = f + 1 iExt = Len(objAttachments.Item(i).FileName) - InStrRev(objAttachments.Item(i).FileName, ".") strE = Right(objAttachments.Item(i).FileName, iExt) attFileName = Left(objAttachments.Item(i).FileName, Len(objAttachments.Item(i).FileName) - iExt - 1) attFileName = strR & "_" & k & "_" & j & ".pdf" attPath = msgfolder & "\" & attFileName objAttachments.Item(i).SaveAsFile attPath Next i End If End If Next objMsg ExitSub: Set objAttachments = Nothing Set objMsg = Nothing Set objSelectedItems = Nothing Set olns = Nothing MsgBox "Attachments have been successfully saved." Exit Sub ErrorHandler: MsgBox "Saveattachments( ) Subroutine" & vbCrLf & vbCrLf & "Error Code: " & Err.Number & vbCrLf & Err.Description Err.Clear GoTo ExitSub End Sub
Add your voice to the tech community where 5M+ people just like you are talking about what matters.
Join the community of 500,000 technology professionals and ask your questions.