如何將列表框變爲文本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")