如何将列表框转换为 Excel VBA 的文本

Question

我正在尝试使电子邮件自动化，但是当我尝试从列表框发送行时遇到问题；我尝试了几种不同的方法，但都没有接近工作。另外，我不知道如何使用该列。我目前正试图让它通过

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")