Macro to save attachments to files

[admirablewizard]

Good afternoon,

I have been using this code to save PDF files to my documents. My computer was just updated so all of my files are now under Microsoft onedrive so I guess it is not longer saving the files to the right location (or at all really). How can I change this to a folder in onedrive? Or a folder I can just keep on my desktop?

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

Thank you for your time!

 

[Logit]

You need to edit this line of code toward the top of your macro :

' Get the path to your My Documents folder
    strFolderpath = CreateObject("WScript.Shell").SpecialFolders(16)

Something like :

strFolderpath = "C:\Users\YOURCOMPUTERNAMEHERE\Desktop\MyFolder\"

 

[admirablewizard]

You need to edit this line of code toward the top of your macro :

' Get the path to your My Documents folder
    strFolderpath = CreateObject("WScript.Shell").SpecialFolders(16)

Something like :

strFolderpath = "C:\Users\YOURCOMPUTERNAMEHERE\Desktop\MyFolder\"

Hey, that worked! Thanks so much.

 

[Logit]

You are welcome.

 

[petergroft]

Click Start, type OneDrive in the search box, and then click OneDrive in the search results.) Help & Settings > Settings. Next to the location where you want to choose folders, select Choose folders.

Hope This Works,
Peter