将列表框项添加为电子邮件附件

时间:2016-05-10 17:19:29

标签: excel vba excel-vba excel-2010

我在表单上有一个子目录,旨在允许用户报告错误并建议对表单进行改进。我已经准备好了,但是继续遇到添加附件的问题。

Sub Submit()
Dim OutApp As Object
Dim OutMail As Object
Dim Item
Dim STR As String, AdminOnly As String, TruncBox As String, STRAttachments As String

For Each cCont In Me.MultiPage1.SelectedItem.Controls
    Select Case TypeName(cCont)
        Case "TextBox"
            If cCont.value = "Please enter a short description here." Or _
                cCont.value = "Please enter a short description here." Then
                    MsgBox ("Please enter all information.")
                    Exit Sub
            ElseIf cCont.value = "" Then
                MsgBox ("Please enter all information.")
                Exit Sub
            End If
        Case "ComboBox"
            If cCont.value = "" Then
                MsgBox ("Please enter all information.")
                Exit Sub
            ElseIf InStr(cCont.value, "Report") Then
                TruncBox = "BUG"
            Else
                TruncBox = "SUGGESTION"
            End If
    End Select
Next

STR = "{email address redacted}"
If RecipientsListBox.ListCount = 0 Then
    AdminOnly = MsgBox("Only admin will receive updates!", _
        vbOKCancel + vbExclamation, "No Users on Watch List")
    If AdminOnly = vbCancel Then
        Exit Sub
    Else
        STR = STR
    End If
Else
    For Each Item In RecipientsListBox.List
        STR = STR & ";" & Item
    Next Item
End If

Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")

On Error GoTo cleanup
    Set OutMail = OutApp.CreateItem(0)
    On Error Resume Next
    With OutMail
        .to = STR
        Call .Recipients.resolveall
        .Subject = TruncBox & ": " & ActiveWorkbook.Name & ": " & ShortDescriptionTextBox
        .Body = LongDescriptionTextBox
        If AttachmentsListBox.ListCount = 0 Then
        Else
            For Each Item In AttachmentsListBox.List
                STRAttachments = Item
                .Attachments.Add STRAttachments
            Next Item
        End If
        '.Send  'Or use Display
        .Display
    End With
    On Error GoTo 0
    Set OutMail = Nothing
cleanup:
Set OutApp = Nothing
Application.ScreenUpdating = True
End Sub

我已经尝试循环遍历AttachmentsListBox控件上的每个项目,并准备寻求帮助。此最新尝试生成Run-time error '94': Invalid use of Null,其中行STRAttachments = Item在突出显示的部分中返回null。看看我已经拥有的东西,并与互联网上的其他搜索进行比较,我不明白。我在上面的行Item中将变体STR返回到STR = STR & ";" & Item,我看到其他字符串示例作为附件返回。我错过了什么?

1 个答案:

答案 0 :(得分:2)

所以,这是我过去发现的一个问题,但我还没有彻底研究根本原因。 ListBox.List返回ListObjects的多维数组。因此,即使您有一个包含1列的ListBox,List数组也有多列。当您使用For Each循环进行循环时,它会尝试访问这些其他列中的值,这只会产生Null值。尝试使用带有计数器的For循环,例如:

Private Sub UserFormButton_Click()
    For i = 0 To Me.ListBox1.ListCount - 1
        MsgBox Me.ListBox1.List(i)
    Next i
End Sub