从列表框中选择要附加到电子邮件中的多个项目

时间:2016-01-06 20:19:33

标签: vba ms-access access-vba outlook-vba

我已经构建了一个包含多个文件的数据库,例如用户手册。我在Access中创建的表单之一是搜索字段,它使用查询来查找用户正在查找的特定文件。搜索将结果缩小到一个列表框,双击将为您打开文件。结果也根据文档类型缩小为选项卡。我已经实现了一项功能,如果您单击选择(文件)结果以突出显示它,然后单击按钮,它会将该文件插入到MS Outlook中的新邮件中。这很好但我想在同一封电子邮件中选择多个文件。我一直在网上搜索,似乎找不到合适的解决方案。我将在下面列出我的代码。

第一件作品以我的搜索表格编码。

Private Sub cmdEMail_Click()

Dim fpath As String

'Find out what tab user is on
Select Case Me!tabResults.Value
Case 0
    If IsNull(lstManResults.Column(5, lstManResults.ListIndex)) Then
        Exit Sub
    Else
        fpath = lstManResults.Column(5, lstManResults.ListIndex)
    End If
Case 1
    If IsNull(lstBullResults.Column(5, lstBullResults.ListIndex)) Then
        Exit Sub
    Else
        fpath = lstBullResults.Column(5, lstBullResults.ListIndex)
    End If
Case 2
    If IsNull(lstSubResults.Column(5, lstSubResults.ListIndex)) Then
        Exit Sub
    Else
        fpath = lstSubResults.Column(5, lstSubResults.ListIndex)
    End If
Case 3
        If IsNull(lstPicResults.Column(5, lstPicResults.ListIndex)) Then
        Exit Sub
    Else
        fpath = lstPicResults.Column(5, lstPicResults.ListIndex)
    End If
Case 4
    If IsNull(lstWarrResults.Column(5, lstWarrResults.ListIndex)) Then
        Exit Sub
    Else
        fpath = lstWarrResults.Column(5, lstWarrResults.ListIndex)
    End If
Case 5
    If IsNull(lstPartResults.Column(5, lstPartResults.ListIndex)) Then
        Exit Sub
    Else
        fpath = lstPartResults.Column(5, lstPartResults.ListIndex)
    End If
Case 6
    If IsNull(lstSchemResults.Column(5, lstSchemResults.ListIndex)) Then
        Exit Sub
    Else
        fpath = lstSchemResults.Column(5, lstSchemResults.ListIndex)
    End If
Case 7
    If IsNull(lstAppResults.Column(5, lstAppResults.ListIndex)) Then
        Exit Sub
    Else
        fpath = lstAppResults.Column(5, lstAppResults.ListIndex)
    End If
Case 8
    If IsNull(lstSpecResults.Column(5, lstSpecResults.ListIndex)) Then
        Exit Sub
    Else
        fpath = lstSpecResults.Column(5, lstSpecResults.ListIndex)
    End If
Case 9
    If IsNull(lstInternalResults.Column(5, lstInternalResults.ListIndex)) Then
        Exit Sub
    Else
        fpath = lstInternalResults.Column(5, lstInternalResults.ListIndex)
    End If
Case 10
    If IsNull(lstAddenSuppResults.Column(5, lstAddenSuppResults.ListIndex)) Then
        Exit Sub
    Else
        fpath = lstAddenSuppResults.Column(5, lstAddenSuppResults.ListIndex)
    End If
Case 11
    If IsNull(lstVideoResults.Column(5, lstVideoResults.ListIndex)) Then
        Exit Sub
    Else
        fpath = lstVideoResults.Column(5, lstVideoResults.ListIndex)
    End If
Case 12
    If IsNull(lstTechTipsResults.Column(5, lstTechTipsResults.ListIndex)) Then
        Exit Sub
    Else
        fpath = lstTechTipsResults.Column(5, lstTechTipsResults.ListIndex)
    End If
Case 13
    If IsNull(lstArchiveResults.Column(5, lstArchiveResults.ListIndex)) Then
        Exit Sub
    Else
        fpath = lstArchiveResults.Column(5, lstArchiveResults.ListIndex)
    End If
End Select

EmailDoc fpath

End Sub

此代码是我为处理电子邮件操作而创建的功能:

Function EmailDoc(ByVal fpath As String)

'Get Outlook if it isn't open already
Set outlookApp = CreateObject("Outlook.Application")
Set outlookItem = outlookApp.CreateItem(0)

If Err <> 0 Then
    'Outlook wasn't running, start it
    Set outlookApp = CreateObject("Outlook.Application")
    Started = True
End If

With outlookItem
    .to = ""
    .Subject = "Requested Document"
    .Body = "Thank you"
    .attachments.Add (fpath)

    .display

End With

End Function

非常感谢任何帮助。

1 个答案:

答案 0 :(得分:0)

试试这两个链接:

cycling through values in a MS Access list box

https://support.microsoft.com/en-us/kb/827423

它们显示了处理多个列表框选择的两种不同方式。