Vba 通过电子邮件发送两份PDF

我制作的代码（如下所示）通过电子邮件正确发送一个PDF，但我需要再发送一个PDF

Dim varFindThis As Variant
Dim rngLookIn As Range

varFindThis = Worksheets("Suivi").Range("B1")

Set rngLookIn = Worksheets("Suivi").Range("A:A")

If Not rngLookIn.Find(varFindThis, LookIn:=xlValues) Is Nothing Then

Dim f       As String

f = Worksheets("Suivi").Range("B1").Value

'Since i didn't got that clear, here above you must create a code to declare "f" as whatever you want

Set c = Worksheets("Suivi").Range("A:A").Find(f)

Worksheets("Suivi").Range(c.Address).EntireRow.Delete

End If



'Do not forget to change the email ID
'before running this code

    Dim OlApp As Object
    Dim NewMail As Object
    Dim TempFilePath As String
    Dim TempFileName As String
    Dim FileFullPath As String

   ' With Application
     '   .ScreenUpdating = False
      '  .EnableEvents = False
   ' End With


  Application.DisplayFullScreen = False

ThisWorkbook.Worksheets("PDF").Activate

Range("B1:BG46").Select

ActiveSheet.PageSetup.PrintArea = "$B$1:$BG$46"



' Temporary file path where pdf
' file will be saved before
' sending it in email by attaching it.

    TempFilePath = Environ$("temp") & "\"

' Now append a date and time stamp
' in your pdf file name. Naming convention
' can be changed based on your requirement.

    TempFileName = ActiveSheet.Name & "-" & Format(Now, "dd-mmm-20yy") & ".pdf"

'Complete path of the file where it is saved
    FileFullPath = TempFilePath & TempFileName

'Now Export the Activesshet as PDF with the given File Name and path

    On Error GoTo err
    With ActiveSheet
        .ExportAsFixedFormat _
        Type:=xlTypePDF, _
        Filename:=FileFullPath, _
        Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, _
        OpenAfterPublish:=False
    End With

'Now open a new mail

    Set OlApp = CreateObject("Outlook.Application")



'Loop through the rows
For Each cell In ThisWorkbook.Sheets("Envoie").Columns("C").Cells.SpecialCells(xlCellTypeVisible)
If cell.Value Like "*@*" Then
EmailAddr1 = EmailAddr1 & ";" & cell.Value
End If
Next

For Each cell In ThisWorkbook.Sheets("Envoie").Columns("G").Cells.SpecialCells(xlCellTypeVisible)
If cell.Value Like "*@*" Then
EmailAddr2 = EmailAddr2 & ";" & cell.Value
End If
Next

    Subj = "N°Article" & ThisWorkbook.Sheets("CalculInfo").Range("A10")

    Set NewMail = OlApp.CreateItem(0)

    On Error Resume Next
    With NewMail
        .To = EmailAddr1
        .CC = EmailAddr2
        .BCC = "gaetan.affolter@he-arc.ch"
        .Subject = Subj

        .Body = "Bonjour, il vous reste 24 heures pour vérifier les données du PDF et de confirmer dans Octopus. Merci"
        .Attachments.Add FileFullPath '--- full path of the pdf where it is saved
        .Send   'or use .Display to show you the email before sending it.
     End With
    On Error GoTo 0

'Since mail has been sent with the attachment
'Now delete the pdf file from the temp folder

    Kill FileFullPath

'set nothing to the objects created
    Set NewMail = Nothing
    Set OlApp = Nothing

'Now set the application properties back to true
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
    MsgBox ("Email a été envoyé")
    Exit Sub
err:
        MsgBox err.Description

       Unload Me

打印区域I位于工作表（“CalcGammeControle”）中，更准确地说，位于“$G$2:$G$35”中

---

如何添加它？

只需添加另一个

.Attachments.add

，然后添加第二个pdf的文件路径。抱歉，它不起作用，我想我不知道如何声明它：-/只需添加另一个

.Attachments.add

然后添加第二个pdf的文件路径。抱歉，它不起作用，我想我不知道如何声明它：-/