Belli sayfaları Pdf formatında e-mail olarak gönderme

Believing

Altın Üye
Katılım
19 Mayıs 2013
Mesajlar
700
Excel Vers. ve Dili
Office Pro 2019 TR 32 Bit
Windows Pro 10 TR 64 Bit
Altın Üyelik Bitiş Tarihi
23-08-2028
Sayın Uzman arkadaşlar,

Aşağıdaki alıntı olan kod ile aktif sayfayı ".pdf" formatında e-mail gönderiyorum.
Aktif sayfa yerine "LICENSE", "TEMPLATE", "PARAMETRE", "SETTINGS" sayfaları hariç, diğer sayfaları tek bir pdf dosyası olarak göndermek istiyorum.
Outlook'a eklenecek PDF dosyası ismini, çalışma kitabı ismi ile "SETTINGS" isimli sayfanın "H3" hücresi birleştirilerek gönderilmelidir.(Örnek; "E-Mail Gönder-01.04.2021")
Yukarıda belirttiğim koşulları sağlamak için mevcut kodu nasıl revize etmeliyim.
Benim için çok değerli olan yardımlarınızı rica ederim.

Saygılarımla.

Kod:
Sub AttachActiveSheetPDF()
Dim IsCreated As Boolean
Dim i As Long
Dim PdfFile As String, Title As String
Dim OutlApp As Object

' Not sure for what the Title is
Title = Range("H20")

' Define PDF filename
PdfFile = ActiveWorkbook.FullName
i = InStrRev(PdfFile, ".")
If i > 1 Then PdfFile = Left(PdfFile, i - 1)
PdfFile = PdfFile & "_" & ActiveSheet.Name & ".pdf"

' Export activesheet as PDF
With ActiveSheet
.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
End With

' Use already open Outlook if possible
On Error Resume Next
Set OutlApp = GetObject(, "Outlook.Application")
If Err Then
Set OutlApp = CreateObject("Outlook.Application")
IsCreated = True
End If
OutlApp.Visible = True
On Error GoTo 0

' Prepare e-mail with PDF attachment
With OutlApp.CreateItem(0)

' Prepare e-mail
.Subject = Title
.To = Range("H13") ' <-- Put email of the recipient here
.CC = Range("H17") ' <-- Put email of 'copy to' recipient here
.Body = Range("h23")
.Attachments.Add PdfFile

' Try to send
On Error Resume Next
.Send
Application.Visible = True
If Err Then
MsgBox "E-mail was not sent", vbExclamation
Else
MsgBox "E-mail successfully sent", vbInformation
End If
On Error GoTo 0

End With

' Delete PDF file
Kill PdfFile

' Quit Outlook if it was created by this code
If IsCreated Then OutlApp.Quit

' Release the memory of object variable
Set OutlApp = Nothing

End Sub
 

Believing

Altın Üye
Katılım
19 Mayıs 2013
Mesajlar
700
Excel Vers. ve Dili
Office Pro 2019 TR 32 Bit
Windows Pro 10 TR 64 Bit
Altın Üyelik Bitiş Tarihi
23-08-2028
Sayın Uzman arkadaşlar,

Ekteki örnek çalışmada ilk mesajda istenenlerden bazılarını yapabildim.
Eksik kalan senaryoları tamamlamak için yardımlarınızı rica ediyorum.
Aktif sayfa yerine "LICENSE", "TEMPLATE", "PARAMETRE", "SETTINGS" sayfaları hariç, diğer sayfaları tek bir pdf dosyası olarak gönderilmelidir.
"SETTINGS" sayfasının "H23", "H25", "H31" hücrelerinde metinleri alt alta sıralanmsını sağlamak için mevcut kodları nasıl revize etmeliyim.

Saygılarımla.
 

Ekli dosyalar

Believing

Altın Üye
Katılım
19 Mayıs 2013
Mesajlar
700
Excel Vers. ve Dili
Office Pro 2019 TR 32 Bit
Windows Pro 10 TR 64 Bit
Altın Üyelik Bitiş Tarihi
23-08-2028
Sayın Uzman arkadaşlar,

Konu aktif olup, henüz kendi uğraşlarım neticesinde herhangi bir sonuca ulaşamadım.
Benim için çok değerli olan yardımlarınızı rica ederim.

Saygılarıma
 
Üst