none
Problem closing out user properties RRS feed

  • Question

  • Hello -

    I'm using the code below (very bottom) to copy the content of items in a journal folder to a calendar folder. I have about 27000 entries I need to move. The code normally fails after about 300 entries are copied with an error message that varies from specifically an out of memory run-time error to a several different, more vague, run-time errors. During the run, the memory use starts around 70MB and goes to over 500MB before failing. When I try to close outlook a message box pops up over and over asking if I want to save changes. I've counted the number of times the message box opens - it is equal to the number of entries copied. I've narrowed the problem down to the code that sets the user properties for my custom fields within my For loop:

            Set objJournalProperties = journal.UserProperties
            Set objCalendarProperties = calendarItem.UserProperties

            Set objProjectJournal = objJournalProperties.Add("Project", olKeywords)
            Set objProjectCalendar = objCalendarProperties.Add("Project", olKeywords)
            Set objCollaboratorJournal = objJournalProperties.Add("Collaborator", olKeywords)
            Set objCollaboratorCalendar = objCalendarProperties.Add("Collaborator", olKeywords)
            Set objExperimenterJournal = objJournalProperties.Add("Experimenter", olKeywords)
            Set objExperimenterCalendar = objCalendarProperties.Add("Experimenter", olKeywords)

    I found in this forum entry that changing properties (http://www.outlookcode.com/threads.aspx?forumid=5&messageid=30376) when opening a new outlook item can cause the entry to be "dirty" and cause this problem but I don't know how to set the user defined properties for the field any other way. Is there a way to establish the user properties for the whole folder outside the loop and then just define the values for the properties in the loop?

    Any advice would be much appreciated!

    Best wishes,

    Stacey

                                                                                                                           

    Here is the entire code I'm using:

    Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
    Private Declare Function EmptyClipboard Lib "user32" () As Long
    Private Declare Function CloseClipboard Lib "user32" () As Long

    Sub outlookSelection()

        Dim selection As Outlook.selection
        Dim count As Integer
        Dim counter As Integer
        Dim divby10 As Integer
        Dim remainder As Integer
        Dim quotient As Integer
        Dim batch As Integer

        Set selection = ActiveExplorer.selection

        count = selection.count
        Set selection = Nothing
        remainder = count Mod 10
        divby10 = count - remainder
        quotient = divby10 / 10
        batch = 10

       counter = 1

       For j = 1 To quotient
            Call processSelection(batch, counter)

            counter = counter + 10
       Next

       Call processSelection(remainder, counter)



    End Sub

    Sub processSelection(ByVal batch As Integer, ByVal counter As Integer)
        Dim selection As Outlook.selection
        Dim i As Integer
        Set selection = ActiveExplorer.selection

        Dim NS As Outlook.NameSpace
        Set NS = Application.GetNamespace("MAPI")
        Dim journal As Outlook.JournalItem


        'Define variables to create new calendar entry for each journal item
        Dim calendar As Outlook.Folder
        Set calendar = GetFolderPath("Outlook Data File\Databook")
        Dim calendarItem As Outlook.AppointmentItem

        'Define all user property variables
        Dim objProjectJournal As Outlook.UserProperty
        Dim objProjectCalendar As Outlook.UserProperty
        Dim objCollaboratorJournal As Outlook.UserProperty
        Dim objCollaboratorCalendar As Outlook.UserProperty
        Dim objExperimenterJournal As Outlook.UserProperty
        Dim objExperimenterCalendar As Outlook.UserProperty
        Dim objJournalProperties As Outlook.UserProperties
        Dim objCalendarProperties As Outlook.UserProperties


        'Define variables to use the word editor
        Dim objInsp As Outlook.Inspector
        Dim objWord As Word.Application
        Dim objOldDoc As Word.Document
        Dim objNewDoc As Word.Document
        Dim objSel As Word.selection


        'Dim objSelNew As Word.selection
        Dim objRangeNew As Word.Range
        Dim objRange As Word.Range



         For i = counter To (counter + batch - 1)
            Set journal = selection.Item(i)
            Set calendarItem = calendar.Items.Add(olAppointmentItem)
            calendarItem.Subject = journal.Subject
            calendarItem.Start = journal.Start
            calendarItem.Categories = journal.Categories
            calendarItem.Duration = journal.Duration


            Set objJournalProperties = journal.UserProperties
            Set objCalendarProperties = calendarItem.UserProperties

            Set objProjectJournal = objJournalProperties.Add("Project", olKeywords)
            Set objProjectCalendar = objCalendarProperties.Add("Project", olKeywords)
            Set objCollaboratorJournal = objJournalProperties.Add("Collaborator", olKeywords)
            Set objCollaboratorCalendar = objCalendarProperties.Add("Collaborator", olKeywords)
            Set objExperimenterJournal = objJournalProperties.Add("Experimenter", olKeywords)
            Set objExperimenterCalendar = objCalendarProperties.Add("Experimenter", olKeywords)


            objProjectCalendar.Value = objProjectJournal.Value
            objCollaboratorCalendar.Value = objCollaboratorJournal.Value
            objExperimenterCalendar.Value = objExperimenterJournal.Value




            calendarItem.Display
            Set objInsp = calendarItem.GetInspector
            Set objNewDoc = objInsp.WordEditor
            Set objWord = objNewDoc.Application
            Set objSel = objWord.selection


            Set objOldDoc = journal.GetInspector.WordEditor
            Set objRange = objOldDoc.Content
            objRange.Select
            objRange.Copy


            objSel.PasteAndFormat (wdFormatOriginalFormatting)
            Call ClearClipboard


            calendarItem.Close (olSave)
            journal.Close (olDiscard)


            Set objJournalProperties = Nothing
            Set objCalendarProperties = Nothing
            Set calendarItem = Nothing
            Set journal = Nothing
            Set objInsp = Nothing
            Set objOldDoc = Nothing
            Set objNewDoc = Nothing
            Set objWord = Nothing
            Set objSel = Nothing
            Set objRange = Nothing
            Set objProjectJournal = Nothing
            Set objProjectCalendar = Nothing
            Set objCollaboratorJournal = Nothing
            Set objCollaboratorCalendar = Nothing
            Set objExperimenterJournal = Nothing
            Set objExperimenterCalendar = Nothing


            Call ClearClipboard


        Next
            DoEvents

           Set selection = Nothing
           Set NS = Nothing
           Set calendar = Nothing


    End Sub


    Sub ClearClipboard()
        OpenClipboard (0&)
        EmptyClipboard
        CloseClipboard
    End Sub

    Function GetFolderPath(ByVal FolderPath As String) As Outlook.Folder
    Dim oFolder As Outlook.Folder
    Dim FoldersArray As Variant
    Dim i As Integer

    On Error GoTo GetFolderPath_Error
    If Left(FolderPath, 2) = "\\" Then
    FolderPath = Right(FolderPath, Len(FolderPath) - 2)
    End If
    'Convert folderpath to array
    FoldersArray = Split(FolderPath, "\")
    Set oFolder = Application.Session.Folders.Item(FoldersArray(0))
    If Not oFolder Is Nothing Then
    For i = 1 To UBound(FoldersArray, 1)
    Dim SubFolders As Outlook.Folders
    Set SubFolders = oFolder.Folders
    Set oFolder = SubFolders.Item(FoldersArray(i))
    If oFolder Is Nothing Then
    Set GetFolderPath = Nothing
    End If
    Next
    End If
    'Return the oFolder
    Set GetFolderPath = oFolder
    Exit Function

    GetFolderPath_Error:
    Set GetFolderPath = Nothing
    Exit Function
    End Function

    Tuesday, May 30, 2017 5:20 PM

All replies

  • You are still using multiple dot notation

    Change the code

    For i = counter To (counter + batch - 1)
            Set journal = selection.Item(i)
            Set calendarItem = calendar.Items.Add(olAppointmentItem)

    to

    set items = calendar.Items
    For i = counter To (counter + batch - 1)
            Set journal = selection.Item(i)
            Set calendarItem = items.Add(olAppointmentItem)


    Dmitry Streblechenko (MVP)
    http://www.dimastr.com/redemption
    Redemption - what the Outlook
    Object Model should have been
    Version 5.5 is now available!

    Tuesday, May 30, 2017 5:49 PM
  • Thanks for your response, Dmitry!

    I adjusted the code as you suggested but still have the same problem. My user properties are associated with a custom form. I thought maybe the problem was trying to assign the properties to the default form message class. I tried to use the code below instead...but it doesn't actually seem to add a new item in my custom message class.

    I'm using my custom for "DataForm" as the default in my folder. If I create a new item from the outlook interface it opens with the correct custom form...but this doesn't seem to work. Could this be the problem? Any idea where I might be going wrong?

    Thanks again!

    Stacey


         For i = counter To (counter + batch - 1)
            Set journal = selection.Item(i)
            Set calendarItem = calendarItems.Add("IPM.Appointment.DataForm")

    Tuesday, May 30, 2017 6:20 PM
  • Hello -

    The question in my most recent response can be disregarded - I was using the wrong name  for my custom message class.

    With regard to the message boxes that pop up for each entry copied, it looks like I made a mistake with one version of my custom add-in. I must not have bound the user property to the control. If I save changes to the original entry that I am copying, I no longer get the message boxes upon closing but I also lose the values in the fields. Is there a way I can use VBA to save the text in the controls to a userproperty?

    Also, even with this fix, I still have a memory leak that prevents the code from processing more than 200-300 items. I'd really appreciate any input on how to fix this.

    Thanks,

    Stacey

    Tuesday, May 30, 2017 7:35 PM