Saving Outlook file to a folder

Sonya810

Registered User.
Local time
Yesterday, 20:25
Joined
Mar 8, 2018
Messages
22
I am trying to look for a specific file in Outlook and save it to a folder in my Documents. Can someone please help.
 
Here is something that I run from within Outlook to reduce the size of the pst files.
Cobbled together from snippets on the Net

HTH

Code:
Public Sub ReplaceAttachmentsToLink()
Dim objApp As Outlook.Application
Dim aMail As Outlook.MailItem 'Object
Dim oAttachments As Outlook.Attachments
Dim oSelection As Outlook.Selection
Dim i As Long
Dim iCount As Long
Dim sFile As String
Dim sFolderPath As String
Dim sDeletedFiles As String
Dim sDate As String, sTime As String
  
    ' Get the path to your My Documents folder
    sFolderPath = CreateObject("WScript.Shell").SpecialFolders(16)
    On Error Resume Next
  
    ' Instantiate an Outlook Application object.
    Set objApp = CreateObject("Outlook.Application")
  
    ' Get the collection of selected objects.
    Set oSelection = objApp.ActiveExplorer.Selection
  
    ' Set the Attachment folder.
    sFolderPath = sFolderPath & "\OLAttachments"
  
    'If folder does not exist create it
    If Dir(sFolderPath, vbDirectory) = "" Then
        MkDir sFolderPath
    End If
    
    ' Check each selected item for attachments. If attachments exist,
    ' save them to the Temp folder and strip them from the item.
    For Each aMail In oSelection
  
    ' This code only strips attachments from mail items.
    ' If aMail.class=olMail Then
    ' Get the Attachments collection of the item.
    Set oAttachments = aMail.Attachments
    iCount = oAttachments.Count
      
        
    If iCount > 0 Then
      
        ' We need to 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 = iCount To 1 Step -1
          
            ' Save attachment before deleting from item.
            ' Get the file name.
            sFile = oAttachments.item(i).FileName
            
            'Now get Date & Time as strings to use in filename
            sDate = Format(Now(), "yyyymmdd")
            sTime = Format(Now(), "hhmmss")
              
            ' Combine with the path to the Temp folder.
            sFile = sFolderPath & "\" & sDate & "_" & sTime & "_" & sFile
              
            ' Save the attachment as a file.
            oAttachments.item(i).SaveAsFile sFile
              
            ' Delete the attachment.
            oAttachments.item(i).Delete
              
            'write the save as path to a string to add to the message
            'check for html and use html tags in link
            If aMail.BodyFormat <> olFormatHTML Then
                sDeletedFiles = sDeletedFiles & vbCrLf & "<file://" & sFile & ">"
            Else
                sDeletedFiles = sDeletedFiles & "<br>" & "<a href='file://" & _
                sFile & "'>" & sFile & "</a>"
            End If
              
                          
        Next i
        'End If
              
       ' Adds the filename string to the message body and save it
       ' Check for HTML body
       If aMail.BodyFormat <> olFormatHTML Then
           aMail.Body = aMail.Body & vbCrLf & _
           "The file(s) were saved to " & sDeletedFiles
       Else
           aMail.HTMLBody = aMail.HTMLBody & "<p>" & _
           "The file(s) were saved to " & sDeletedFiles & "</p>"
       End If
        
       aMail.Save
       'sets the attachment path to nothing before it moves on to the next message.
       sDeletedFiles = ""
     
       End If
    Next 'end aMail
      
ExitSub:
  
Set oAttachments = Nothing
Set aMail = Nothing
Set oSelection = Nothing
Set objApp = Nothing
End Sub
 
Neat. Though I'd be saving the changes to the email body before removing the attachments just in case ...
 
Neat. Though I'd be saving the changes to the email body before removing the attachments just in case ...

If you want to tweak it to make if better, I'd like to see and implement that?
 

Users who are viewing this thread

Back
Top Bottom