Loading
Ozgrid Excel Help & Best Practices Forums

Excel Training / Excel Dashboards Reports



Results 1 to 6 of 6

Thread: Saving excel attchements from microsoft outlook

  1. #1
    Join Date
    14th November 2016
    Posts
    7

    Saving excel attchements from microsoft outlook

    I receive several email with a standard format attachment. I am trying to save the attachments to a folder on my desktop using a macro. I have used a code which I found on another post and it is not working. The code I used is shown below.
    VB:
    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 = CreateObject("Outlook.Application") 
         
         
         ' Get the collection of selected objects.
        Set objSelection = objOL.ActiveExplorer.Selection 
         
         
         ' Set the Attachment folder.
        strFolderpath = strFolderpath & "P:\Gestion de Congé\Congé Noel Concierge" 
         
         
         ' Check each selected item for attachments. If attachments exist,
         ' save them to the strFolderPath folder and strip them from the item.
        For Each objMsg In objSelection 
             
             
             ' This code only strips attachments from mail items.
             ' If objMsg.class=olMail Then
             ' Get the Attachments collection of the item.
            Set objAttachments = objMsg.Attachments 
            lngCount = objAttachments.Count 
            strDeletedFiles = "" 
             
             
            If lngCount > 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 = lngCount To 1 Step -1 
                     
                     
                     ' Save attachment before deleting from item.
                     ' 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 
                     
                     
                     ' Delete the attachment.
                    objAttachments.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 objMsg.BodyFormat <> olFormatHTML Then 
                        strDeletedFiles = strDeletedFiles & vbCrLf & "<file://" & strFile & ">" 
                    Else 
                        strDeletedFiles = strDeletedFiles & "<br>" & "<a href='file://" & _ 
                        strFile & "'>" & strFile & "</a>" 
                    End If 
                     
                     
                     'Use the MsgBox command to troubleshoot. Remove it from the final code.
                     'MsgBox strDeletedFiles
                     
                     
                Next I 
                 
                 
                 ' Adds the filename string to the message body and save it
                 ' Check for HTML body
                If objMsg.BodyFormat <> olFormatHTML Then 
                    objMsg.Body = vbCrLf & "The file(s) were saved to " & strDeletedFiles & vbCrLf & objMsg.Body 
                Else 
                    objMsg.HTMLBody = "<p>" & "The file(s) were saved to " & strDeletedFiles & "</p>" & objMsg.HTMLBody 
                End If 
                objMsg.Save 
            End If 
        Next 
         
         
    ExitSub: 
         
         
        Set objAttachments = Nothing 
        Set objMsg = Nothing 
        Set objSelection = Nothing 
        Set objOL = Nothing 
    End Sub 
    
    

    Excel Video Tutorials / Excel Dashboards Reports


  2. #2
    Join Date
    16th June 2005
    Location
    Dublin
    Posts
    5,196

    Re: Saving excel attchements from microsoft outlook

    Thx for posting your code....
    It is not working
    Do you want to tell us what is not working, or do you want us to guess?

    What symptoms or errors are you seeing?

    Cheers
    Ger

    Check out our new reputation system. Click on the "star" under the post!
    _______________________________________________

    There are 10 types of people in the world. Those that understand Binary and those that dont.

    Why are Halloween and Christmas the same? Because Oct 31 = Dec 25...

    The BEST Lookup function of all time

    Dynamic Named Ranges are your bestest friend

    _______________________________________________

  3. #3
    Join Date
    14th November 2016
    Posts
    7

    Re: Saving excel attchements from microsoft outlook

    Hi,


    Sorry about that.The macro is giving me the message that it has saved the attachment in the file path I indicated. However when I go to the file path the attachments are not there. Also I don't want the attachment in outlook to be deleted.

    Excel Video Tutorials / Excel Dashboards Reports


  4. #4
    Join Date
    26th January 2003
    Location
    Indiana, USA
    Posts
    846

    Re: Saving excel attchements from microsoft outlook

    Edited your code to this and it worked on my Outlook.
    (Added a folder to my desktop named "Outlook Attachments").
    VB:
    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("Desktop") 
        On Error Resume Next 
         
         
         ' Instantiate an Outlook Application object.
        Set objOL = CreateObject("Outlook.Application") 
         
         
         ' Get the collection of selected objects.
        Set objSelection = objOL.ActiveExplorer.Selection 
         
         
         ' Set the Attachment folder.
        strFolderpath = strFolderpath & "\Outlook Attachments\" 
         
         
         ' Check each selected item for attachments. If attachments exist,
         ' save them to the strFolderPath folder
        For Each objMsg In objSelection 
             
             
             ' This code only strips attachments from mail items.
             ' If objMsg.class=olMail Then
             ' Get the Attachments collection of the item.
            Set objAttachments = objMsg.Attachments 
            lngCount = objAttachments.Count 
            strDeletedFiles = "" 
             
             
            If lngCount > 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 = lngCount To 1 Step -1 
                     
                     ' Save attachment before deleting from item.
                     ' 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 
    
    

    Excel Video Tutorials / Excel Dashboards Reports


  5. #5
    Join Date
    14th November 2016
    Posts
    7

    Re: Saving excel attchements from microsoft outlook

    [QUOTE=dangelor;783472]Edited your code to this and it worked on my Outlook.
    (Added a folder to my desktop named "Outlook Attachments").[CODE]Public Sub SaveAttachments()

    Hi,

    Thanks for your help. I have copied the code to my outlook and only cahnged the path for the folder on my desktop. It is still not working. The attachments are not saved in the path indicated. I am wondering whether it has something to do with my macro security set up or some other settings in microsoft outlook.

    Thank you for helping.


    VB:
    Public Sub SaveAttachmentsA()    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("\C:\Users\sjugoo\Desktop") 
        On Error Resume Next 
         
         
         ' Instantiate an Outlook Application object.
        Set objOL = CreateObject("Outlook.Application") 
         
         
         ' Get the collection of selected objects.
        Set objSelection = objOL.ActiveExplorer.Selection 
         
         
         ' Set the Attachment folder.
        strFolderpath = strFolderpath & "\Outlook Attachements\" 
         
         
         ' Check each selected item for attachments. If attachments exist,
         ' save them to the strFolderPath folder
        For Each objMsg In objSelection 
             
             
             ' This code only strips attachments from mail items.
             ' If objMsg.class=olMail Then
             ' Get the Attachments collection of the item.
            Set objAttachments = objMsg.Attachments 
            lngCount = objAttachments.Count 
            strDeletedFiles = "" 
             
             
            If lngCount > 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 = lngCount To 1 Step -1 
                     
                     ' Save attachment before deleting from item.
                     ' 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 
    
    

    Excel Video Tutorials / Excel Dashboards Reports


  6. #6
    Join Date
    14th November 2016
    Posts
    7

    Re: Saving excel attchements from microsoft outlook

    Hello,

    I came across a macro which worked fine. It retrieves all my attachements which are in either excel, word or pdf and saves it on my desktop The macro is attached below. I am now trying to amend the macro so that it can open an outlook item (not an outlook attachment) whthin which is the attachement in excel format and save the file on my desktop. Thank you for helping.

    VB:
    Sub GetAttachments() 
        On Error Resume Next 
         'create the folder if it doesnt exists:
        Dim FSO, ttxtfile, txtfile, WheretosaveFolder 
        Dim objFolders As Object 
        Set objFolders = CreateObject("WScript.Shell").SpecialFolders 
         
         'MsgBox objFolders("mydocuments")
        ttxtfile = objFolders("mydocuments") 
         
        Set FSO = CreateObject("Scripting.FileSystemObject") 
        Set txtfile = FSO.CreateFolder(ttxtfile & "\Email Attachments") 
         ' Changes made by Andrew Davis (adavis@xtheta.com) on October 28th 2015
         ' ------------------------------------------------------
         ' Set fso = Nothing
         ' ------------------------------------------------------
        WheretosaveFolder = ttxtfile & "\Email Attachments" 
         
        On Error Goto GetAttachments_err 
         ' Declare variables
        Dim ns As NameSpace 
        Dim Inbox As MAPIFolder 
        Dim Item As Object 
        Dim Atmt As Attachment 
        Dim FileName As String 
        Dim i As Integer 
        Set ns = GetNamespace("MAPI") 
         'Set Inbox = ns.GetDefaultFolder(olFolderInbox)
         ' added the option to select whic folder to export
        Set Inbox = ns.PickFolder 
         
         'to handle if the use cancalled folder selection
        If Inbox Is Nothing Then 
            MsgBox "You need to select a folder in order to save the attachments", vbCritical, _ 
            "Export - Not Found" 
            Exit Sub 
        End If 
         
         
         ''''
         
         
         
        i = 0 
         ' Check Inbox for messages and exit of none found
        If Inbox.Items.Count = 0 Then 
            MsgBox "There are no messages in the selected folder.", vbInformation, _ 
            "Export - Not Found" 
            Exit Sub 
        End If 
         ' Check each message for attachments
        For Each Item In Inbox.Items 
             ' Save any attachments found
            For Each Atmt In Item.Attachments 
                 ' This path must exist! Change folder name as necessary.
                 
                 ' Changes made by Andrew Davis (adavis@xtheta.com) on October 28th 2015
                 ' ------------------------------------------------------
                FileName = WheretosaveFolder & "\" & FSO.GetBaseName(Atmt.FileName) & i & "." & FSO.GetExtensionName(Atmt.FileName) 
                 ' ------------------------------------------------------
                Atmt.SaveAsFile FileName 
                i = i + 1 
            Next Atmt 
        Next Item 
         ' Show summary message
        If i > 0 Then 
            MsgBox "There were " & i & " attached files." _ 
            & vbCrLf & "These have been saved to the Email Attachments folder in My Documents." _ 
            & vbCrLf & vbCrLf & "Thank you for using Liron Segev - TheTechieGuy's utility", vbInformation, "Export Complete" 
        Else 
            MsgBox "There were no attachments found in any mails.", vbInformation, "Export - Not Found" 
        End If 
         ' Changes made by Andrew Davis (adavis@xtheta.com) on October 28th 2015
         ' ------------------------------------------------------
        Set FSO = Nothing 
         ' ------------------------------------------------------
         ' Clear memory
    GetAttachments_exit: 
        Set Atmt = Nothing 
        Set Item = Nothing 
        Set ns = Nothing 
        Exit Sub 
         ' Handle errors
    GetAttachments_err: 
        MsgBox "An unexpected error has occurred." _ 
        & vbCrLf & "Please note and report the following information." _ 
        & vbCrLf & "Macro Name: GetAttachments" _ 
        & vbCrLf & "Error Number: " & Err.Number _ 
        & vbCrLf & "Error Description: " & Err.Description _ 
        , vbCritical, "Error!" 
        Resume GetAttachments_exit 
    End Sub 
    
    

    Excel Video Tutorials / Excel Dashboards Reports


Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Possible Answers

  1. Microsoft office excel has stopped working on saving
    By Zura K in forum Excel General
    Replies: 4
    Last Post: February 28th, 2015, 06:38
  2. Replies: 1
    Last Post: November 22nd, 2014, 06:17
  3. Replies: 50
    Last Post: November 12th, 2013, 23:03
  4. Replies: 3
    Last Post: March 7th, 2012, 16:05
  5. Excel/microsoft outlook automatic emailing
    By RAJRAJ85 in forum Excel and/or Email Help
    Replies: 1
    Last Post: January 23rd, 2012, 05:19

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  
porno