I have an Outlook userform to show selected emails.
Since listboxes cannot have text in the column-headers, I adapted the solution proposed here.
My Problem:
After intialization of the form, the header-box is at a wrong position and with a wrong size. Some checks show, that the correct values are allocated by the function createListboxHeader() - and without error. But checking the header-box's position and size after that function (back in initialization), the values are wrong - prove of what I see.
Sometimes it works correctly, but most of the times not.
Code:
Public Sub createListboxHeader(lstBody As ListBox, arrHeaders)
Dim lstHeader As ListBox
Dim i As Integer
'create new listbox for the header
Set lstHeader = Me.Controls.Add("Forms.ListBox.1","NameOnlyForTesting")
With lstBody
'ensure properties of body-listbox
.ColumnHeads = False
.ZOrder (1)
.SpecialEffect = fmSpecialEffectFlat
.BorderStyle = fmBorderStyleSingle
End With
With lstHeader
'properties of header-listbox
.BackColor = RGB(200, 200, 200)
.Enabled = False
.ZOrder (0)
.SpecialEffect = fmSpecialEffectFlat
.BorderStyle = fmBorderStyleSingle
'make column equal
.ColumnCount = lstBody.ColumnCount
.ColumnWidths = lstBody.ColumnWidths
'add header elements
.AddItem
For i = 0 To UBound(arrHeaders)
.List(0, i) = arrHeaders(i)
Next i
'positioning of header-listbox
.Height = 10
.Width = lstBody.Width
.Left = lstBody.Left
.Top = (lstBody.Top - lstHeader.Height) - 0
Debug.Print lstBody.Width, lstHeader.Height ' <-- show both '400'
End With
End Sub
Usage:
Private Sub UserForm_Initialize()
'find emails
Dim selEmails As Outlook.Selection
Set selEmails = getSelectedEmails() 'function not displayed here at StackOverflow
'show emails in List-Box
Call printSelectedEmailsInList(selEmails)
End Sub
Private Sub printSelectedEmailsInList(selectedEmails As Outlook.Selection)
Dim objEmail As Outlook.MailItem
Dim intCounter As Integer
Dim arrHeaders() As Variant
With Me.lstSelectedEmails
'configure listbox
.Clear
.ColumnCount = 5
.ColumnWidths = "70;100;100;200;100"
'configute header (AFTER body!)
arrHeaders = Array("Date", "From", "To", "Subject", "Folder")
Call createListboxHeader(Me.lstSelectedEmails, arrHeaders)
MsgBox Me.Controls("NameOnlyForTesting").Width '<-- shows'78' instead of '400'
'fill list with emails
intCounter = 0
For Each objEmail In selectedEmails
.AddItem
.List(intCounter, 0) = objEmail.SentOn
.List(intCounter, 1) = objEmail.SenderName
.List(intCounter, 2) = objEmail.To
.List(intCounter, 3) = objEmail.Subject
.List(intCounter, 4) = objEmail.Parent.Name
intCounter = intCounter + 1
Next
End With
End Sub
I solved my problem, by changing:
Private Sub UserForm_Initialize()
[...]
End Sub
to:
Private Sub UserForm_Activate()
[...]
End Sub