PDF kaydedip Otomatik Mail Gönderme

[27style]

Merhaba,

Ekte ilettiğim şablondaki 1'den 13'e kadar olan sekmeleri günlük olarak ayrı ayrı bugünün tarihiyle birlikte, bugünün tarihiyle açılmış bir klasör içerisine PDF olarak kaydediyorum.
(Örn : 17.06 - 1.pdf , 17.06 - 2.pdf ...)

Daha sonra oluşturduğum PDF'lerin her birini farklı mail alıcılarıyla mail içerisine PDF dosyasını ekleyerek paylaşıyorum.
(Örn : "17.06 - 1 nolu rapor ekte yer almaktadır.", "17.06 - 2 nolu rapor ekte yer almaktadır." ...)

Yukarıdaki işlemlerin otomatik makro kullanarak yapmaya çalışıyor fakat dökümanların içerisinden kendime uygun bir format bulamıyorum.

Bu konuda bana yardımcı olabilirseniz minnettar olurum.

Herkese şimdiden çok teşekkürler.

 

[Emir Hüseyin Çoban]

.

PDF oluşturmak için kullandığınız ayrı bir kod var mı yoksa ellemi yapıyorsunuz.

.

 

[27style]

merhaba evet ilgili sayfada farklı kaydet seçeneğiyle PDF seçerek kaydediyorum. zaten PDF kaydetme seçeneklerinde 'yalnızca seçili sekmeyi PDF'e çevir' seçeneği otomatik seçili geliyor.

 

[Emir Hüseyin Çoban]

.

Bilgisayarınızdaki 17.06.2020 klasör yolunu yazar mısınız.

.

 

[27style]

C:\Users\Serdar Demir\Desktop altında "17.06" adıyla bir klasör oluşturup dökümanları bunun altına ekleyebilirse harika olur.

 

[Emir Hüseyin Çoban]

Akşam atarım kodları..


.

 

[27style]

çok teşekkürler elinize sağlık

 

[Emir Hüseyin Çoban]

.

Sub KOD()

    sor = InputBox("Gün Girin" & Chr(10) & "Format gün.ay.yıl", "", Format(Date, "dd.mm.yyyy"))
    If sor = "" Then Exit Sub

    klasoryolu = CreateObject("WScript.Shell").specialfolders("Desktop") & "\" & sor

    If CreateObject("scripting.filesystemobject").folderexists(klasoryolu) = False Then
        MsgBox "Klasör İsmi: " & sor & Chr(10) & "Yok. Oluşturuluyor...", vbCritical
        CreateObject("scripting.filesystemobject").createfolder (klasoryolu)
    End If

    For i = 1 To 13
        Sheets(i).ExportAsFixedFormat Type:=xlTypePDF, _
                                      Filename:=klasoryolu & "\" & Format(sor, "dd.mm") & " - " & i & ".pdf", _
                                      Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
    Next i


    Dim xlOutlook As Object
    Set xlOutlook = CreateObject("Outlook.Application")
    Set xlMail = xlOutlook.CreateItem(0)

    Dim xlMail1 As Object, xlMail2 As Object, xlMail3 As Object, xlMail4 As Object, xlMail5 As Object
    Dim xlMail6 As Object, xlMail7 As Object, xlMail8 As Object, xlMail9 As Object, xlMail10 As Object
    Dim xlMail11 As Object, xlMail12 As Object, xlMail13

    Set xlMail1 = xlOutlook.CreateItem(0): Set xlMail2 = xlOutlook.CreateItem(0): Set xlMail3 = xlOutlook.CreateItem(0): Set xlMail4 = xlOutlook.CreateItem(0): Set xlMail5 = xlOutlook.CreateItem(0)
    Set xlMail6 = xlOutlook.CreateItem(0): Set xlMail7 = xlOutlook.CreateItem(0): Set xlMail8 = xlOutlook.CreateItem(0): Set xlMail9 = xlOutlook.CreateItem(0): Set xlMail10 = xlOutlook.CreateItem(0)
    Set xlMail11 = xlOutlook.CreateItem(0): Set xlMail12 = xlOutlook.CreateItem(0): Set xlMail13 = xlOutlook.CreateItem(0)

    pdfsor1 = klasoryolu & "\" & Format(sor, "dd.mm") & " - 1.pdf"
    If Dir(pdfsor1) = "" Then
        MsgBox "PDF yok: " & pdfsor1 & Chr(10) & "bu raporun gönderimi iptal", vbCritical
    Else
        With xlMail1
            .To = "bir@mail.com"
            .CC = ""
            .Subject = ""
            .Body = Format(sor, "dd.mm") & " - 1 nolu rapor ekte yer almaktadır."
            .Attachments.Add pdfsor1
            .Save
            .Send
        End With
    End If
    Set xlMail1 = Nothing


    pdfsor2 = klasoryolu & "\" & Format(sor, "dd.mm") & " - 2.pdf"
    If Dir(pdfsor2) = "" Then
        MsgBox "PDF yok: " & pdfsor2 & Chr(10) & "bu raporun gönderimi iptal", vbCritical
    Else
        With xlMail2
            .To = "iki@mail.com"
            .CC = ""
            .Subject = ""
            .Body = Format(sor, "dd.mm") & " - 2 nolu rapor ekte yer almaktadır."
            .Attachments.Add pdfsor2
            .Save
            .Send
        End With
    End If
    Set xlMail2 = Nothing

    pdfsor3 = klasoryolu & "\" & Format(sor, "dd.mm") & " - 3.pdf"
    If Dir(pdfsor3) = "" Then
        MsgBox "PDF yok: " & pdfsor3 & Chr(10) & "bu raporun gönderimi iptal", vbCritical
    Else
        With xlMail3
            .To = "uc@mail.com"
            .CC = ""
            .Subject = ""
            .Body = Format(sor, "dd.mm") & " - 3 nolu rapor ekte yer almaktadır."
            .Attachments.Add pdfsor3
            .Save
            .Send
        End With
    End If
    Set xlMail3 = Nothing

    pdfsor4 = klasoryolu & "\" & Format(sor, "dd.mm") & " - 4.pdf"
    If Dir(pdfsor4) = "" Then
        MsgBox "PDF yok: " & pdfsor4 & Chr(10) & "bu raporun gönderimi iptal", vbCritical
    Else
        With xlMail4
            .To = "dort@mail.com"
            .CC = ""
            .Subject = ""
            .Body = Format(sor, "dd.mm") & " - 4 nolu rapor ekte yer almaktadır."
            .Attachments.Add pdfsor4
            .Save
            .Send
        End With
    End If
    Set xlMail4 = Nothing

    pdfsor5 = klasoryolu & "\" & Format(sor, "dd.mm") & " - 5.pdf"
    If Dir(pdfsor5) = "" Then
        MsgBox "PDF yok: " & pdfsor5 & Chr(10) & "bu raporun gönderimi iptal", vbCritical
    Else
        With xlMail5
            .To = "bes@mail.com"
            .CC = ""
            .Subject = ""
            .Body = Format(sor, "dd.mm") & " - 5 nolu rapor ekte yer almaktadır."
            .Attachments.Add pdfsor5
            .Save
            .Send
        End With
    End If
    Set xlMail5 = Nothing

    pdfsor6 = klasoryolu & "\" & Format(sor, "dd.mm") & " - 6.pdf"
    If Dir(pdfsor6) = "" Then
        MsgBox "PDF yok: " & pdfsor6 & Chr(10) & "bu raporun gönderimi iptal", vbCritical
    Else
        With xlMail6
            .To = "alti@mail.com"
            .CC = ""
            .Subject = ""
            .Body = Format(sor, "dd.mm") & " - 6 nolu rapor ekte yer almaktadır."
            .Attachments.Add pdfsor6
            .Save
            .Send
        End With
    End If
    Set xlMail6 = Nothing

    pdfsor7 = klasoryolu & "\" & Format(sor, "dd.mm") & " - 7.pdf"
    If Dir(pdfsor7) = "" Then
        MsgBox "PDF yok: " & pdfsor7 & Chr(10) & "bu raporun gönderimi iptal", vbCritical
    Else
        With xlMail7
            .To = "yedi@mail.com"
            .CC = ""
            .Subject = ""
            .Body = Format(sor, "dd.mm") & " - 7 nolu rapor ekte yer almaktadır."
            .Attachments.Add pdfsor7
            .Save
            .Send
        End With
    End If
    Set xlMail7 = Nothing


    pdfsor8 = klasoryolu & "\" & Format(sor, "dd.mm") & " - 8.pdf"
    If Dir(pdfsor8) = "" Then
        MsgBox "PDF yok: " & pdfsor8 & Chr(10) & "bu raporun gönderimi iptal", vbCritical
    Else
        With xlMail8
            .To = "sekiz@mail.com"
            .CC = ""
            .Subject = ""
            .Body = Format(sor, "dd.mm") & " - 8 nolu rapor ekte yer almaktadır."
            .Attachments.Add pdfsor8
            .Save
            .Send
        End With
    End If
    Set xlMail8 = Nothing


    pdfsor9 = klasoryolu & "\" & Format(sor, "dd.mm") & " - 9.pdf"
    If Dir(pdfsor9) = "" Then
        MsgBox "PDF yok: " & pdfsor9 & Chr(10) & "bu raporun gönderimi iptal", vbCritical
    Else
        With xlMail9
            .To = "dokuz@mail.com"
            .CC = ""
            .Subject = ""
            .Body = Format(sor, "dd.mm") & " - 9 nolu rapor ekte yer almaktadır."
            .Attachments.Add pdfsor9
            .Save
            .Send
        End With
    End If
    Set xlMail9 = Nothing


    pdfsor10 = klasoryolu & "\" & Format(sor, "dd.mm") & " - 10.pdf"
    If Dir(pdfsor10) = "" Then
        MsgBox "PDF yok: " & pdfsor10 & Chr(10) & "bu raporun gönderimi iptal", vbCritical
    Else
        With xlMail10
            .To = "on@mail.com"
            .CC = ""
            .Subject = ""
            .Body = Format(sor, "dd.mm") & " - 10 nolu rapor ekte yer almaktadır."
            .Attachments.Add pdfsor10
            .Save
            .Send
        End With
    End If
    Set xlMail10 = Nothing

    pdfsor11 = klasoryolu & "\" & Format(sor, "dd.mm") & " - 11.pdf"
    If Dir(pdfsor11) = "" Then
        MsgBox "PDF yok: " & pdfsor11 & Chr(10) & "bu raporun gönderimi iptal", vbCritical
    Else
        With xlMail11
            .To = "onbir@mail.com"
            .CC = ""
            .Subject = ""
            .Body = Format(sor, "dd.mm") & " - 11 nolu rapor ekte yer almaktadır."
            .Attachments.Add pdfsor11
            .Save
            .Send
        End With
    End If
    Set xlMail11 = Nothing

    pdfsor12 = klasoryolu & "\" & Format(sor, "dd.mm") & " - 12.pdf"
    If Dir(pdfsor12) = "" Then
        MsgBox "PDF yok: " & pdfsor12 & Chr(10) & "bu raporun gönderimi iptal", vbCritical
    Else
        With xlMail12
            .To = "oniki@mail.com"
            .CC = ""
            .Subject = ""
            .Body = Format(sor, "dd.mm") & " - 12 nolu rapor ekte yer almaktadır."
            .Attachments.Add pdfsor12
            .Save
            .Send
        End With
    End If
    Set xlMail12 = Nothing


    pdfsor13 = klasoryolu & "\" & Format(sor, "dd.mm") & " - 13.pdf"
    If Dir(pdfsor13) = "" Then
        MsgBox "PDF yok: " & pdfsor13 & Chr(10) & "bu raporun gönderimi iptal", vbCritical
    Else
        With xlMail13
            .To = "onuc@mail.com"
            .CC = ""
            .Subject = ""
            .Body = Format(sor, "dd.mm") & " - 13 nolu rapor ekte yer almaktadır."
            .Attachments.Add pdfsor13
            .Save
            .Send
        End With
    End If
    Set xlMail13 = Nothing


    Set xlOutlook = Nothing
    MsgBox "B i t t i "
End Sub

.

 

[27style]

ellerinize, aklınıza sağlık çok teşekkür ediyorum.
günlük 20 dakikamı bana geri verdiniz. ne kadar teşekkür etsem az.

 

[eceLprensi]

Merhaba,
@27style çok güzel bir soru sormuş saolsun

Bu mail adreslerini mail adındaki bir sayfadan almasını nasıl sağlarım.

makroya gömmek yerine. mail adreslerinin yanınada gitmesi gereken sayfayı yazıp.

Teşekkürler