如何将Listbox转换为Excel VBA文本 [英] How to turn Listbox to Text for Excel VBA

问题描述

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

  Dim listboxarr（）
 Dim i As Integer 
 
对于i = 1到500 
'v这是一个列表框
与selecteditems 
 listboxarr（1）= .List（i，1）
结束
下一个我
  

此代码抛出我：

订阅超出范围

这是电子邮件的代码：

  Private Sub addcb_Click（）
 Dim iCtr As Long 
 
对于iCtr = 0 To Me.allitems.ListCount -  1 
如果Me.allitems.Selected（iCtr）= True然后
 Me.selecteditems.AddItem Me.allitems.List（iCtr）
结束如果
下一个iCtr 
 
对于iCtr = Me.allitems.ListCount  -  1到0步骤-1 
如果Me.allitems.Selected（iCtr）= True然后
 Me.allitems.RemoveItem iCtr 
 End If 
 Next iCtr 
 End Sub 
 
 
 Private Sub removecb_Click（）
 Dim iCtr As Long 
 
对于iCtr = 0 To Me.selecteditems.ListCount  -  1 
如果Me.selecteditems.Selected（iCtr）= True然后
 Me.allitems.AddItem Me.selecteditems.List（iCtr ）
 End If 
 Next iCtr 
 
对于iCtr = Me.selecteditems.ListCount  -  1到0 Step -1 
如果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 
 
对于i = 1到500 
'v这是一个列表框
与selecteditems 
 listboxarr（1 ）= .List（i，1）
 End with 
 Next i 
 
 Dim OutApp As Object 
 Dim OutMail As Object 
 
 Set OutApp = CreateObject（Outlook.Application）
设置OutMail = OutApp.CreateItem（0）
 
错误恢复下一步
 .to =有人
。 CC =Someone
 .BCC =
 .Subject =Something
 .Body = listboxarr（1）
结束
错误GoTo 0 
 
设置OutMail = Nothing 
设置OutApp = Nothing 
 
 Private Sub UserForm_Initialize ）
 
 Dim itemsheet As Worksheet 
设置itemsheet = Application.ActiveWorkbook.Sheets（6）
 
对于每个项目名称在itemsheet.Range（C2：C3285） 
与Me.allitems 
 .AddItem itemname.Value 
结束
下一个项目名称
 
 End Sub 
  

解决方案

如果您允许列表框的MultiSelect属性为True，请尝试此...

  Dim listboxarr（）
 Dim i As Long，j As Long 
 
'假设你的名字ListBox是ListBox1。如果没有，请在以下代码中更改它。 
 
 With Me.ListBox1 
 For i = 0 To .ListCount  -  1 
如果.Selected（i）然后
j = j + 1 
 ReDim Preserve listboxarr（1到j）
 listboxarr（j）= .List（i）
结束如果
下一个i 
结束
  / pre> 
 
 
 编辑代码 
  Dim listboxarr（）
 Dim i As Long，j As Long 
 Dim found As Boolean 
 
'假设您的ListBox的名称是ListBox1。如果没有，请在以下代码中更改它。 
 
 With Me.ListBox1 
 For i = 0 To .ListCount  -  1 
 If .Selected（i）Then 
 found = True 
j = j + 1 
 ReDim保存列表框（1到j）
 listboxarr（j）= .List（i）
结束如果
下一个i 
结束
  
然后你可以像下面这样使用... 
  .body = IIf（found，Join（listboxarr，，），No item selected）
  
 
I am trying to automatize an e-mail, but I am having a problem when I try to send lines from listbox; I have tried a few different ways none that were even close to working. In addition, I don't know how to use the column. I am currrently tryying to get it to work via
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
This code throws me:

  
Subscription out of Range
This is the code for the email:
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

解决方案
If you have allowed the MultiSelect property for the listbox to True, try this...
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
And then you can use it like below...
.body = IIf(found, Join(listboxarr, ", "), "No item selected")


                        
这篇关于如何将Listbox转换为Excel VBA文本的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！