none
Outlook 2013 - VBA Listbox make selected item a named variable RRS feed

  • Question

  • I am pretty sure I am missing something easy.

    I have a Outlook 2013 macro that creates an array of folder names and populates those names to a listbox in a userform.  The folder names are selected based on a conversation.

    I want to set the listbox's selected item to a variable and make this variable usable in the module that called the userform.

    I've declared this variable - strTgtFolder -  as a public string variable.

    However, when I attempt to assign a value to this variable in the userform's code, VBA chokes and says the variable is undefined. 

    Note: I the code pulling the folder names and loads them into an array works fine.  I included it for the sake of completeness.

    Option Explicit Public strTgtFolder As String Sub MoveConverToSelectedFolder() Dim oConv As Outlook.conversation Dim oTable As Outlook.table Dim oRow As Outlook.Row Dim oMail As Outlook.mailItem Dim oItem As Outlook.mailItem Dim oFolder As Outlook.Folder Dim strFolderName As String Dim strFolderPath As String Dim arFolderNameList() As Variant Dim arFolderPathList() As Variant Dim iArrayCount As Integer Dim iCount As Integer Dim bDup As Boolean Dim bEmpty As Boolean Dim bCancel As Boolean ' *** This code works fine. Skip to next set of *** to see where the problem code starts. Const PR_STORE_ENTRYID As String = _ "http://schemas.microsoft.com/mapi/proptag/0x0FFB0102" iArrayCount = 0 bDup = False bEmpty = True On Error Resume Next ' Obtain the current item for the active explorer, which is the main window in outlool. Set oMail = Outlook.ActiveExplorer.Selection.item(1) If Not (oMail Is Nothing) Then ' Obtain the Conversation object. Set oConv = oMail.GetConversation If Not (oConv Is Nothing) Then Set oTable = oConv.GetTable oTable.Columns.Add (PR_STORE_ENTRYID) Do Until oTable.EndOfTable Set oRow = oTable.GetNextRow ' Use EntryID and StoreID to open the item. Set oItem = Application.Session.GetItemFromID( _ oRow("EntryID"), _ oRow.BinaryToString(PR_STORE_ENTRYID)) strFolderName = oItem.Parent.Name strFolderPath = oItem.Parent.FolderPath Debug.Print strFolderName, strFolderPath 'Populate the array holding the names where items might be filed. 'Check to see if the name array is empty. 'If the array is not empty check to see if the candidate is a duplicate item. 'Array Data. Column 0 = folder name, Column 1 = folder path If Not bEmpty Then ' Check to see whether or not the item to be entered is a duplicate or not. For iCount = 0 To UBound(arFolderNameList) If arFolderNameList(iCount) = strFolderName Or strFolderName = "Inbox" Or strFolderName = "Sent" Then bDup = True Exit For Else bDup = False End If Next ' Add the mail item if it is not a duplidate. Use a ReDim statement to exand the dynamic name array. If Not bDup Then iArrayCount = iArrayCount + 1 ReDim Preserve arFolderNameList(iArrayCount) ReDim Preserve arFolderPathList(iArrayCount) arFolderNameList(iArrayCount) = strFolderName arFolderPathList(iArrayCount) = strFolderPath End If End If ' This bit of code enters the array's first item. Oddly enough, it needs to come last. If bEmpty Then If strFolderName <> "Inbox" Then If strFolderName <> "Sent" Then ReDim Preserve arFolderNameList(iArrayCount) ReDim Preserve arFolderPathList(iArrayCount) arFolderNameList(iArrayCount) = strFolderName arFolderPathList(iArrayCount) = strFolderPath bEmpty = False End If End If End If Loop End If End If

    *** Problem code starts here ***

    UserForm1.ListBox1.Clear For iCount = 0 To UBound(arFolderNameList) ' Debug.Print iCount, arFolderNameList(iCount), arFolderPathList(iCount) UserForm1.ListBox1.AddItem arFolderNameList(iCount) Next iCount UserForm1.Show MsgBox "The list box value is " & strTgtFolder End Sub ' ** userform code ** Option Explicit Private Sub cmdCancel_Click() Unload Me End End Sub Private Sub cmdOK_Click() strTgtFolder = ListBox1.Value Unload Me End Sub Private Sub UserForm_Initialize() End Sub


    Thanks,

    Monday, February 29, 2016 5:52 AM

Answers

  • This is the sort of thing that happens when you unload the userform before processing the data. Instead change the userform code to

    Private Sub cmdCancel_Click()
        Me.hide
        Me.Tag = 0
    End Sub
    
    Private Sub cmdOK_Click()
        Me.hide
        Me.Tag = 1
    End Sub
    

    and change the errant section of your main code to

        *** Problem code starts here ***
    
        UserForm1.ListBox1.Clear
        For iCount = 0 To UBound(arFolderNameList)
            UserForm1.ListBox1.AddItem arFolderNameList(iCount)
        Next iCount
    
        UserForm1.Show
        With UserForm1
            If .Tag = 1 Then
                strTgtFolder = .ListBox1.Text
                MsgBox "The list box value is " & strTgtFolder
            End If
        End With
        Unload UserForm1


    Graham Mayor - Word MVP
    www.gmayor.com

    • Proposed as answer by André Santo Monday, February 29, 2016 11:31 AM
    • Marked as answer by Exiled_In_CA Monday, February 29, 2016 7:51 PM
    Monday, February 29, 2016 6:11 AM

All replies

  • This is the sort of thing that happens when you unload the userform before processing the data. Instead change the userform code to

    Private Sub cmdCancel_Click()
        Me.hide
        Me.Tag = 0
    End Sub
    
    Private Sub cmdOK_Click()
        Me.hide
        Me.Tag = 1
    End Sub
    

    and change the errant section of your main code to

        *** Problem code starts here ***
    
        UserForm1.ListBox1.Clear
        For iCount = 0 To UBound(arFolderNameList)
            UserForm1.ListBox1.AddItem arFolderNameList(iCount)
        Next iCount
    
        UserForm1.Show
        With UserForm1
            If .Tag = 1 Then
                strTgtFolder = .ListBox1.Text
                MsgBox "The list box value is " & strTgtFolder
            End If
        End With
        Unload UserForm1


    Graham Mayor - Word MVP
    www.gmayor.com

    • Proposed as answer by André Santo Monday, February 29, 2016 11:31 AM
    • Marked as answer by Exiled_In_CA Monday, February 29, 2016 7:51 PM
    Monday, February 29, 2016 6:11 AM
  • Thanks.  It worked correctly.
    Monday, February 29, 2016 7:52 PM