Maille birden fazla pdf ekleyerek göndermek

[orcunkurtar]

Merhabalar

tablodan veri çekerek oluşturduğum bir kontrol formum var. Butona basınca 15 ayrı pdf oluşup hepsini ayrı mailde atınca mail kutusu çok çabuk doluyor .Bu 15 pdf i tek mailde göndermenin yolu var mıdır ? Mevcut kod aşağıdadır.

Private Sub CommandButton1_Click()
Dim outapp As Outlook.Application
Dim outmail As Outlook.MailItem

For i = 5 To 19
Range("B7") = Sheets("data").Cells(i, 5)
Set outapp = New Outlook.Application

With ActiveSheet.PageSetup
.PrintArea = "$A$1:$F$48"
.FitToPagesWide = 1
.Orientation = xlPortrait
End With

gecicipath = ThisWorkbook.Path & "\"
pdffile = gecicipath & Range("B7") & ".pdf"

Set alan = Range(ActiveSheet.PageSetup.PrintArea)
alan.ExportAsFixedFormat Type:=xlTypePDF, Filename:=pdffile, openafterpublish:=False

Set outmail = outapp.CreateItem(olMailItem)
With outmail
.To = Range("j1")
.Subject = "EMNİYET KEMERİ"
.Body = "Sayın " & Range("B7") & vbCrLf & "Form ektedir."
.Attachments.Add pdffile
.Send
End With


Set outmail = Nothing
Set outapp = Nothing

Next i

End Sub

 

[muhasebeciyiz]

Private Sub CommandButton1_Click()
    Dim outapp As Outlook.Application
    Dim outmail As Outlook.MailItem
    Dim i As Integer
    Dim gecicipath As String
    Dim pdffile As String
    Dim attachmentsFolder As String
    Dim pdfFiles() As String
    Dim attachment As Variant
    Dim folderPath As String
  
    Set outapp = New Outlook.Application
    Set outmail = outapp.CreateItem(olMailItem)
   
    folderPath = "C:\Users\KullanıcıAdı\Documents\PDFs\"
    
    If Dir(folderPath, vbDirectory) = "" Then
        MkDir folderPath
    End If
    
    gecicipath = folderPath
    
    For i = 5 To 19
        Range("B7") = Sheets("data").Cells(i, 5)
        
        With ActiveSheet.PageSetup
            .PrintArea = "$A$1:$F$48"
            .FitToPagesWide = 1
            .Orientation = xlPortrait
        End With

        pdffile = gecicipath & Range("B7") & ".pdf"
        
        Set alan = Range(ActiveSheet.PageSetup.PrintArea)
        alan.ExportAsFixedFormat Type:=xlTypePDF, fileName:=pdffile, openafterpublish:=False
      
        ReDim Preserve pdfFiles(i - 5)
        pdfFiles(i - 5) = pdffile
    Next i
   
    With outmail
        .To = Range("J1")
        .Subject = "EMNİYET KEMERİ"
        .Body = "Sayın " & Range("B7") & vbCrLf & "Form ektedir."
        
        For Each attachment In pdfFiles
            .Attachments.Add attachment
        Next attachment
       
        .Send
    End With
    
    Set outmail = Nothing
    Set outapp = Nothing
    
    Dim fileName As String
    fileName = Dir(gecicipath & "*.pdf")
    Do While fileName <> ""
        Kill gecicipath & fileName
        fileName = Dir
    Loop

End Sub

Not :
Geçici Klasör Oluşturma: PDF dosyalarını geçici bir klasöre kaydediyoruz. Bu klasörün var olup olmadığını kontrol ediyoruz ve yoksa oluşturuyoruz.

Örnek : gecicipath = "C:\Users\KullanıcıAdı\Documents\PDFs\"

Bu durumda, PDF dosyalarınız C:\Users\KullanıcıAdı\Documents\PDFs\ dizininde saklanacaktır. Bu dizinin var olduğundan emin olmalısınız

PDF Oluşturma: Her PDF dosyasını bu geçici klasöre kaydediyoruz ve bir diziye ekliyoruz.

 

[orcunkurtar]

Çok teşekkür ederim. Elinize sağlık