如何将列表框变为文本Excel VBA

Question

我试图自动化电子邮件，但我尝试从列表框发送行时遇到问题;我尝试了几种不同的方式，甚至没有接近工作。另外，我不知道如何使用该列。我currrently tryying让它通过

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 

此代码的工作引发了我：

认购超出范围

的这是电子邮件的代码：

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

如果您已将列表框的MultiSelect属性设置为True，请尝试此操作...

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 

编辑代码：

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 

然后你就可以像下面使用它...

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