從列表框中選擇多個項目以在電子郵件中附加

我已經構建了一個包含多個文件（如用戶手冊）的數據庫。我在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

任何幫助都將不勝感激。

來源

2016-01-06 JB28