Problem automating Outlook 2013 to save attachments
Problem automating Outlook 2013 to save attachments
Problem automating Outlook 2013 to save attachments
Problem automating Outlook 2013 to save attachments
Problem automating Outlook 2013 to save attachments
Problem automating Outlook 2013 to save attachments Problem automating Outlook 2013 to save attachments Problem automating Outlook 2013 to save attachments Problem automating Outlook 2013 to save attachments Problem automating Outlook 2013 to save attachments Problem automating Outlook 2013 to save attachments Problem automating Outlook 2013 to save attachments Problem automating Outlook 2013 to save attachments
Problem automating Outlook 2013 to save attachments Problem automating Outlook 2013 to save attachments
Problem automating Outlook 2013 to save attachments
Go Back  Xtreme Visual Basic Talk > > > Problem automating Outlook 2013 to save attachments


Reply
 
Thread Tools Display Modes
  #1  
Old 11-11-2015, 06:30 AM
Qwanta's Avatar
Qwanta Qwanta is offline
Centurion
 
Join Date: Dec 2003
Location: The Netherlands
Posts: 166
Question Problem automating Outlook 2013 to save attachments


Hi all!

I am trying to make a script that saves all attachments of a certain selection of emails in a specified directory. I have found the following code, it works perfect until it hits the 200st email then the script stops and displays an error:

Error -2147220731 (80040305) during runtime:
The server administrator has limited the amount of opened items. Try closing opened messages or try to remove attachments.

Ofcourse the administrator denies there being a limit set. I thought the problem may occur because the objects are loaded in memory and being kept in memory, so i tried putting the "Object" = Nothing in the loop instead of at the end of the code, to no avail. If anyone had any cleu i would be really happy


Code:
Option Explicit

Public Sub ExportAttachments()
    Dim objOL As Outlook.Application
    Dim objMsg As Object
    Dim objAttachments As Outlook.Attachments
    Dim objSelection As Outlook.Selection
    Dim i As Long, lngCount As Long
    Dim filesRemoved As String, fName As String, strFolder As String, saveFolder As String, savePath As String
    Dim alterEmails As Boolean, overwrite As Boolean
    Dim result
    Dim teller As Long
    Dim vraag As String
    
    saveFolder = BrowseForFolder("Select the folder to save attachments to.")
    If saveFolder = vbNullString Then Exit Sub
    
    Rem result = MsgBox("Do you want to remove attachments from selected file(s)? " & vbNewLine & _
    rem "(Clicking no will export attachments but leave the emails alone)", vbYesNo + vbQuestion)
    Rem alterEmails = (result = vbYes)
    alterEmails = "Onwaar"
    
    Set objOL = CreateObject("Outlook.Application")
    Set objSelection = objOL.ActiveExplorer.Selection
    
    vraag = InputBox("saveFolder='" & saveFolder & "' | alterEmails='" & alterEmails & "'")
    
    For Each objMsg In objSelection
        If objMsg.Class = olMail Then
            Set objAttachments = objMsg.Attachments
            lngCount = objAttachments.Count
            If lngCount > 0 Then
                teller = teller + 1
                filesRemoved = ""
                For i = lngCount To 1 Step -1
                    fName = objAttachments.Item(i).FileName
                    savePath = saveFolder & "\" & fName
                    overwrite = False
                    While Dir(savePath) <> vbNullString And Not overwrite
                        Dim newFName As String
                        newFName = fName & "_" & CStr(teller)
                        Rem newFName = InputBox("The file '" & fName & _
                        rem "' already exists. Please enter a new file name, or just hit OK overwrite.", _
                        rem "Confirm File Name", fName)
                        Rem If newFName = vbNullString Then GoTo skipfile
                        Rem If newFName = fName Then overwrite = True Else fName = newFName
                        savePath = saveFolder & "\" & newFName
                    Wend
                    
                    objAttachments.Item(i).SaveAsFile savePath
                    
                    If alterEmails Then
                        filesRemoved = filesRemoved & "<br>""" & objAttachments.Item(i).FileName & """ (" & _
                                                                formatSize(objAttachments.Item(i).size) & ") " & _
                            "<a href=""" & savePath & """>[Location Saved]</a>"
                        objAttachments.Item(i).Delete
                    End If
skipfile:
                Next i
                
                If alterEmails Then
                    filesRemoved = "<b>Attachments removed</b>: " & filesRemoved & "<br><br>"
                    
                    Dim objDoc As Object
                    Dim objInsp As Outlook.Inspector
                    Set objInsp = objMsg.GetInspector
                    Set objDoc = objInsp.WordEditor

                    objMsg.HTMLBody = filesRemoved + objMsg.HTMLBody
                    objMsg.Save
                End If
            End If
        End If
    Next
    
ExitSub:
    Set objAttachments = Nothing
    Set objMsg = Nothing
    Set objSelection = Nothing
    Set objOL = Nothing
End Sub

Function formatSize(size As Long) As String
    Dim val As Double, newVal As Double
    Dim unit As String
    
    val = size
    unit = "bytes"
    
    newVal = Round(val / 1024, 1)
    If newVal > 0 Then
        val = newVal
        unit = "KB"
    End If
    newVal = Round(val / 1024, 1)
    If newVal > 0 Then
        val = newVal
        unit = "MB"
    End If
    newVal = Round(val / 1024, 1)
    If newVal > 0 Then
        val = newVal
        unit = "GB"
    End If
    
    formatSize = val & " " & unit
End Function

'Function purpose:  To Browser for a user selected folder.
'If the "OpenAt" path is provided, open the browser at that directory
'NOTE:  If invalid, it will open at the Desktop level
Function BrowseForFolder(Optional Prompt As String, Optional OpenAt As Variant) As String
    Dim ShellApp As Object
    Set ShellApp = CreateObject("Shell.Application").BrowseForFolder(0, Prompt, 0, OpenAt)

    On Error Resume Next
    BrowseForFolder = ShellApp.self.Path
    On Error GoTo 0
    Set ShellApp = Nothing
     
    'Check for invalid or non-entries and send to the Invalid error handler if found
    'Valid selections can begin L: (where L is a letter) or \\ (as in \\servername\sharename.  All others are invalid
    Select Case Mid(BrowseForFolder, 2, 1)
        Case Is = ":": If Left(BrowseForFolder, 1) = ":" Then GoTo Invalid
        Case Is = "\": If Not Left(BrowseForFolder, 1) = "\" Then GoTo Invalid
        Case Else: GoTo Invalid
    End Select
     
    Exit Function
Invalid:
     'If it was determined that the selection was invalid, set to False
    BrowseForFolder = vbNullString
End Function

Function BrowseForFile(Optional Prompt As String, Optional OpenAt As Variant) As String
    Dim ShellApp As Object
    Set ShellApp = CreateObject("Shell.Application").BrowseForFolder(0, Prompt, 16 + 16384, OpenAt)
    
    On Error Resume Next
    BrowseForFile = ShellApp.self.Path
    On Error GoTo 0
    Set ShellApp = Nothing
     
    'Check for invalid or non-entries and send to the Invalid error handler if found
    'Valid selections can begin L: (where L is a letter) or \\ (as in \\servername\sharename.  All others are invalid
    Select Case Mid(BrowseForFolder, 2, 1)
        Case Is = ":": If Left(BrowseForFolder, 1) = ":" Then GoTo Invalid
        Case Is = "\": If Not Left(BrowseForFolder, 1) = "\" Then GoTo Invalid
        Case Else: GoTo Invalid
    End Select
     
    Exit Function
Invalid:
     'If it was determined that the selection was invalid, set to False
    BrowseForFile = vbNullString
End Function
__________________
//Qwanta
Electricity is really just organized lightning.
Reply With Quote
  #2  
Old 11-11-2015, 03:18 PM
Cerian Knight's Avatar
Cerian KnightProblem automating Outlook 2013 to save attachments Cerian Knight is offline
Polymath (in disciplina)

Super Moderator
* Expert *
 
Join Date: May 2004
Location: Michigan
Posts: 4,191
Default

Perhaps you should try issuing an explicit .Close before setting to Nothing. Since I'm not sure about the handshaking details before the object is actually disposed, you might need to delay between those two actions.

Let us know if that helps or not.
__________________
I got all the answers wrong on the GLAT, apparently even #9 (where I put a period in the middle of the box and labeled it 'singularity ripe for rapid inflation').
Reply With Quote
  #3  
Old 11-12-2015, 02:27 AM
Qwanta's Avatar
Qwanta Qwanta is offline
Centurion
 
Join Date: Dec 2003
Location: The Netherlands
Posts: 166
Default

Hi Cerian Knight!

First off thank you for your swift reply, unfortunately the object doesnt support a .close property, nor does a delay in the code make a difference. The amount of items that is processed before the error is displayed is 247, it is stuck there everytime which suggest a memory issue.

Maybe you could give me an example based on the code i previously posted?

What i tried until now:
Adding a calculation in a loop for delay purposes.
Adding .close to various objects all gave an error about the syntax.
__________________
//Qwanta
Electricity is really just organized lightning.

Last edited by Qwanta; 11-12-2015 at 05:23 AM.
Reply With Quote
  #4  
Old 11-12-2015, 06:46 AM
Flyguy's Avatar
FlyguyProblem automating Outlook 2013 to save attachments Flyguy is offline
Lost Soul

Super Moderator
* Guru *
 
Join Date: May 2001
Location: Vorlon
Posts: 19,160
Default

Maybe handle it in steps of 100.
So step out of the ExportAttachments method if you have processed 100 emails.
Then everything is closed, including the Outlook session.

Call the ExportAttachments routine in a loop until it doesn't find any unsaved attachments anymore.
Reply With Quote
Reply

Tags
dim, invalid, set, string, newval, goto, function, rem, fname, error, attachments, newfname, filesremoved, unit, val, shellapp, savefolder, alteremails, vbnullstring, object, overwrite, openat, savepath, select, prompt


Currently Active Users Viewing This Thread: 1 (0 members and 1 guests)
 
Thread Tools
Display Modes

Posting Rules
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

BB code is On
Smilies are On
[IMG] code is Off
HTML code is Off

Forum Jump

Advertisement:





Free Publications
The ASP.NET 2.0 Anthology
101 Essential Tips, Tricks & Hacks - Free 156 Page Preview. Learn the most practical features and best approaches for ASP.NET.
subscribe
Programmers Heaven C# School Book -Free 338 Page eBook
The Programmers Heaven C# School book covers the .NET framework and the C# language.
subscribe
Build Your Own ASP.NET 3.5 Web Site Using C# & VB, 3rd Edition - Free 219 Page Preview!
This comprehensive step-by-step guide will help get your database-driven ASP.NET web site up and running in no time..
subscribe
Problem automating Outlook 2013 to save attachments
Problem automating Outlook 2013 to save attachments
Problem automating Outlook 2013 to save attachments Problem automating Outlook 2013 to save attachments
Problem automating Outlook 2013 to save attachments
Problem automating Outlook 2013 to save attachments
Problem automating Outlook 2013 to save attachments Problem automating Outlook 2013 to save attachments Problem automating Outlook 2013 to save attachments Problem automating Outlook 2013 to save attachments Problem automating Outlook 2013 to save attachments Problem automating Outlook 2013 to save attachments Problem automating Outlook 2013 to save attachments
Problem automating Outlook 2013 to save attachments
Problem automating Outlook 2013 to save attachments
 
Problem automating Outlook 2013 to save attachments
Problem automating Outlook 2013 to save attachments
 
-->