У меня есть макрос в VBA Outlook , который создает ListBox. Если я запускаю макрос , появляется следующее изображение . Первый элемент должен быть выбран по умолчанию. Как и в этой картинке .
Я пробовал с
UserForm.ListBox.Selected(0) = True
, но на самом деле это не работает. Все, что я получаю, это пустой список
Как управлять списком с клавиатуры? Мне нужно, чтобы он мог прокручивать вверх и вниз клавишами «ВВЕРХ» и «ВНИЗ», и если нажата «ВВОД», выбранный пункт должен быть взят.
Я пробовал следующее, но это захватывает каждый ENTER "во время кода (не только при загрузке пользовательской формы (ListBox)).
Public Sub Listbox_Enter()
'DO Something
End Sub
Заранее спасибо!
Текущий код:
Option Explicit
Public WithEvents GExplorer As Outlook.Explorer
Public WithEvents GMailItem As Outlook.MailItem
Public WithEvents objInspectors As Outlook.Inspectors
Public WithEvents objTask As Outlook.TaskItem
'Start Outlook
Private Sub Application_Startup()
Set GExplorer = Outlook.Application.ActiveExplorer
Set objInspectors = Outlook.Application.Inspectors
End Sub
'Capture every change, but on same ActiveExplorer (Window)
Private Sub GExplorer_SelectionChange()
Dim xItem As Object
On Error Resume Next
Set xItem = GExplorer.Selection.Item(1)
If xItem.Class <> olMail Then Exit Sub
Set GMailItem = xItem
End Sub
'Reply pressed
Private Sub GMailItem_Reply(ByVal Response As Object, Cancel As Boolean)
AutoAddGreetingtoReply Response
End Sub
'ReplyAll pressed
Private Sub GMailItem_ReplyAll(ByVal Response As Object, Cancel As Boolean)
AutoAddGreetingtoReply Response
End Sub
'Forward pressed
Private Sub GMailItem_Forward(ByVal Response As Object, Cancel As Boolean)
AutoAddGreetingtoReply Response
End Sub
Sub AutoAddGreetingtoReply(Item As Object)
Dim xGreetStr As String: Dim xReplyMail As MailItem
Dim xSenderName As String: Dim lSpace As Long
Dim xRecipient As Recipient: Dim obj As Outlook.MailItem
Dim EmailAdress As String: Dim EmailNameBeforeAtIkon As String:
Dim c As ContactItem
Dim names As String
On Error Resume Next:
Set obj = Outlook.ActiveExplorer.Selection.Item(1)
'This part finds the receipients
If Item.Class <> olMail Then Exit Sub 'Quits if no email is chosen
Set xReplyMail = Item
For Each xRecipient In xReplyMail.Recipients
If xSenderName = "" Then
xSenderName = xRecipient.name
Else
xSenderName = xSenderName & ", " & xRecipient.name
End If
Next xRecipient
Dim lSpace_f As Variant
Dim stFirstNAme As String
Dim st_FirstName As String
Dim currentNAme As String
lSpace_f = InStr(1, xSenderName, " ", vbTextCompare)
If lSpace_f > 0 Then
stFirstNAme = Trim(Split(xSenderName, ",")(1))
st_FirstName = Split(stFirstNAme, " ")(0)
currentNAme = st_FirstName + ","
End If
'Writes a greeting
With UserForm1.Listbox_Auswahl
.AddItem "Hello " + currentNAme
.AddItem "Good morning " + currentNAme
End With
UserForm1.Caption = ("Greeting")
Load UserForm1
UserForm1.StartUpPosition = 2
UserForm1.Show
'Creates the email
With xReplyMail
.Display
.HTMLBody = "<HTML><Body><span style=""color:#0e4a80"">" + markierterEintrag + "</span style=""color:#0e4a80""></HTML></Body>" & .HTMLBody
Sendkeys "{DOWN}", True
Sendkeys "{ENTER}", True
Call Sendkeys("", False)
.Close olSave
End With
End Sub
Public Sub Sendkeys(text As Variant, Optional wait As Boolean = False)
Dim WshShell As Object
Set WshShell = CreateObject("wscript.shell")
WshShell.Sendkeys CStr(text), wait
Set WshShell = Nothing
End Sub
'-------------------------------------
Public Sub Listbox_Auswahl_Click()
If UserForm1.Listbox_Auswahl.ListIndex > -1 Then
markierterEintrag = UserForm1.Listbox_Auswahl.List(UserForm1.Listbox_Auswahl.ListIndex)
End If
Unload UserForm1
End Sub
'Public Sub Listbox_Auswahl_Enter()
' If UserForm1.Listbox_Auswahl.ListIndex > -1 Then
' markierterEintrag = UserForm1.Listbox_Auswahl.List(UserForm1.Listbox_Auswahl.ListIndex)
' End If
'
' Unload UserForm1
'End Sub