Excel mail'i PDF olarak atma

[Emir Hüseyin Çoban]

.

Uygun vakitte TeamViewer ile bağlanıp kontrol edelim.

.

 

[muratgunay48]

.

Uygun vakitte TeamViewer ile bağlanıp kontrol edelim.

.

Çok sevinirim hocam.

 

[metin_0606]

Çok sevinirim hocam.

Netten bulmuştum belki işinizi görür

 

[muratgunay48]

Netten bulmuştum belki işinizi görür

Deneyeceğim, ilginize teşekkür ederim. Neticeyi bildiririm.
Saygılarımla.

 

[muratgunay48]

@Emir Hüseyin Çoban hocam, çok ama çok teşekkür ederim. Sadece emeğiniz için değil vaktiniz için de. Varolun.
Saygılarımla

 

[muratgunay48]

.

PDF adında klasör oluşturmalısınız.

.

Hocam, bu dosya çalıştı. Halen kullanıyorum. Emeğinize sağlık. Peki hocam bu kodları revize edip. Aktif sayfayı PDF olarak kaydedip gönderebilir miyiz?
Subject B1 hücresinde
To B2 hücresinde
cc B3 hücresinde
Şeklinde
Çok denedim yapamadım. Her seferinde bozdum.
Size zahmet hocam, bakabilir misiniz?

Private Sub CommandButton1_Click()
    Dim S1 As Worksheet: Set S1 = Sheets("Mail listesi")
    sayfaad = ActiveSheet.Name
    dosyaad = sayfaad & "_" & Format(Now, "ddmmyyyy_hhmmss") & ".pdf"
    dosyayolu = CreateObject("WScript.Shell").specialfolders("Desktop") & "\PDF\" & dosyaad
    mailadresi = ""
  
    For a = 1 To S1.Cells(1, Columns.Count).End(1).Column
    If S1.Cells(1, a) = sayfaad Then
    For b = 2 To S1.Cells(Rows.Count, a).End(3).Row
    mailadresi = S1.Cells(b, a).Value & ";" & mailadresi
    Next b
    Exit For
    End If
    Next a
      
    If mailadresi = "" Or mailadresi = ";" Then
    MsgBox "Mail Adresi Bulunamadı" & Chr(10) & "İptal", vbCritical
    Exit Sub
    End If
      
    Sheets(sayfaad).ExportAsFixedFormat Type:=xlTypePDF, _
    Filename:=dosyayolu _
    , Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
      
    Dim xlOutlook   As Object
    Dim xlMail      As Object
    Set xlOutlook = CreateObject("Outlook.Application")
    Set xlMail = xlOutlook.CreateItem(0)

    With xlMail
        .To = mailadresi
        '.CC = "bilgimaili@mail.com" 'bilgi maili
        .Subject = Format(Now, "dd.mm.yyyy hh.mm.ss") 'konu
        .Body = "" 'mesaj
        .Attachments.Add dosyayolu
        .Save
        '.Display  'görüntüle
        .Send 'gönder
    End With
  
    Set xlMail = Nothing
    Set xlOutlook = Nothing
  
    Kill dosyayolu

    'MsgBox sayfaad & Chr(10) & "Mail gönderildi", vbInformation

End Sub