使用 VBA Excel 浏览文件夹以在 Outlook 邮件中附加文件 [重复]

Question

我正在开发一个 VBA Excel 中的用户表单，它允许用户提交他们的请求。用户填写表格，然后单击发送按钮。将打开 Outlook 邮件并自动附加完整的表单。

用户通常拥有与请求相关的数据或/和文档。我想向我的用户表单添加功能，允许他们浏览他们的 PC 并导入文件。当他们单击“发送”按钮时，这些文件将附加到与原始 Excel 表单相同的邮件中。

下面是我的发送按钮的代码。

Function CreationMail(criticité As String)
    Dim xFile As String
    Dim xFormat As Long
    Dim Wb As Workbook
    Dim Wb2 As Workbook
    Dim FilePath As String
    Dim FileName As String
    Dim OutlookApp As Object
    Dim OutlookMail As Object
    Dim rng As Range
    
    Set Sheet1 = ThisWorkbook.Sheets("Formulaire")
    Set rng = Sheets("Formulaire").Range("C6:D11").SpecialCells(xlCellTypeVisible)
            
    Application.ScreenUpdating = False
    Set Wb = Application.ActiveWorkbook
    ActiveSheet.Copy
    Set Wb2 = Application.ActiveWorkbook
    Select Case Wb.FileFormat
    Case xlOpenXMLWorkbook:
    xFile = ".xlsx"
    xFormat = xlOpenXMLWorkbook
    Case xlOpenXMLWorkbookMacroEnabled:
    If Wb2.HasVBProject Then
        xFile = ".xlsm"
        xFormat = xlOpenXMLWorkbookMacroEnabled
        Else
        xFile = ".xlsx"
        xFormat = xlOpenXMLWorkbook
    End If
    Case Excel8:
        xFile = ".xls"
        xFormat = Excel8
    Case xlExcel12:
        xFile = ".xlsb"
        xFormat = xlExcel12
    End Select
    FilePath = Environ$("temp") & "\"
    FileName = "STATSAE" & "_" & Format(Now, "yymmdd") & "_" & Format(Now, "hhnnss")

    Set OutlookApp = CreateObject("Outlook.Application")
    Set OutlookMail = OutlookApp.CreateItem(0)
    Wb2.SaveAs FilePath & FileName & xFile, FileFormat:=xFormat
            
    With OutlookMail
        .To = ";" & ";"
        .CC = ""
        If criticité = "Haute" Then
            .Importance = olImportanceHigh
        End If
        If criticité = "" Then
            .Importance = olImportanceNormal
        End If
        If criticité = "Faible" Then
            .Importance = olImportanceNormal
        End If
        .Subject = "Request" & Space(1) & FileName
        .Attachments.Add Wb2.FullName
        .Body = "Please find the requested information" & vbCrLf & "Best Regards"
        .HTMLBody = RangetoHTML(rng)
        .Display
    End With
            
    Wb2.Close
    Kill FilePath & FileName & xFile
    Set OutlookMail = Nothing
    Set OutlookApp = Nothing
    Application.ScreenUpdating = True

End Function

Answer 1

首先，您需要对表单进行自定义以获取需要附加到电子邮件的文件。然后在代码中，您可以为用户选择的每个条目重复Attachments 类的Add 方法。附件的来源可以是文件（由带有文件名的完整文件系统路径表示）或构成附件的 Outlook 项目。

.Attachments.Add Wb2.FullName
.Attachments.Add your_chosen_file