Wie Listbox zu Text für Excel VBA

Question

Ich versuche, eine E-Mail zu automatisieren, aber ich habe ein Problem, wenn ich versuche, Zeilen aus Listbox zu senden; Ich habe ein paar verschiedene Wege ausprobiert, die gar nicht so nah dran waren. Außerdem weiß ich nicht, wie man die Spalte benutzt. Ich tryying currrently, um es über

Dim listboxarr() 
Dim i As Integer 

For i = 1 To 500 
' v this is a listbox 
    With selecteditems 
     listboxarr(1) = .List(i, 1) 
    End With 
Next i 

Dieser Code führt mich zu arbeiten:

Abonnement aus Reichweite

Dies ist der Code für die E-Mail:

Private Sub addcb_Click() 
Dim iCtr As Long 

For iCtr = 0 To Me.allitems.ListCount - 1 
    If Me.allitems.Selected(iCtr) = True Then 
     Me.selecteditems.AddItem Me.allitems.List(iCtr) 
    End If 
Next iCtr 

For iCtr = Me.allitems.ListCount - 1 To 0 Step -1 
    If Me.allitems.Selected(iCtr) = True Then 
     Me.allitems.RemoveItem iCtr 
    End If 
Next iCtr 
End Sub 


Private Sub removecb_Click() 
Dim iCtr As Long 

For iCtr = 0 To Me.selecteditems.ListCount - 1 
    If Me.selecteditems.Selected(iCtr) = True Then 
     Me.allitems.AddItem Me.selecteditems.List(iCtr) 
    End If 
Next iCtr 

For iCtr = Me.selecteditems.ListCount - 1 To 0 Step -1 
     If Me.selecteditems.Selected(iCtr) = True Then 
      Me.selecteditems.RemoveItem iCtr 
     End If 
Next iCtr 
End Sub 

Private Sub CommandButton1_Click() 

Dim listboxarr() 
Dim i As Integer 

For i = 1 To 500 
' v this is a listbox 
    With selecteditems 
     listboxarr(1) = .List(i, 1) 
    End With 
Next i 

Dim OutApp As Object 
Dim OutMail As Object 

Set OutApp = CreateObject("Outlook.Application") 
Set OutMail = OutApp.CreateItem(0) 

On Error Resume Next 
    .to = "Someone" 
    .CC = "Someone else" 
    .BCC = "" 
    .Subject = "Something" 
    .Body = listboxarr(1) 
End With 
On Error GoTo 0 

Set OutMail = Nothing 
Set OutApp = Nothing 

Private Sub UserForm_Initialize() 

Dim itemsheet As Worksheet 
Set itemsheet = Application.ActiveWorkbook.Sheets(6) 

For Each itemname In itemsheet.Range("C2:C3285") 
    With Me.allitems 
     .AddItem itemname.Value 
    End With 
Next itemname 

End Sub 

Answer 1

Wenn Sie die Eigenschaft MultiSelect für das Listenfeld auf True gesetzt haben, versuchen Sie dies ...

Dim listboxarr() 
Dim i As Long, j As Long 

'Assuming the name of your ListBox is ListBox1. If not, change it in the following code. 

With Me.ListBox1 
    For i = 0 To .ListCount - 1 
     If .Selected(i) Then 
      j = j + 1 
      ReDim Preserve listboxarr(1 To j) 
      listboxarr(j) = .List(i) 
     End If 
    Next i 
End With 

Edited Code:

Dim listboxarr() 
Dim i As Long, j As Long 
Dim found As Boolean 

'Assuming the name of your ListBox is ListBox1. If not, change it in the following code. 

With Me.ListBox1 
    For i = 0 To .ListCount - 1 
     If .Selected(i) Then 
      found = True 
      j = j + 1 
      ReDim Preserve listboxarr(1 To j) 
      listboxarr(j) = .List(i) 
     End If 
    Next i 
End With 

Und dann können Sie es wie unten verwenden ...

.body = IIf(found, Join(listboxarr, ", "), "No item selected")