pdf olarak mail yollama

[search77]

Saygı değer arkadaşlar merhaba,
Ekli dosyamda gerekli açıklamaları belirttim.
Bir kod buldum fakat düzeltemedim hata veriyor.
Dosyada kod ve açıklamalarım mevcut.
Yardımcı olabileceklere şimdiden saygılar teşekkürler.

 

[search77]

Arkadaşlar yardımcı olabilecek var mı?
Çok tşk ler

 

[Emir Hüseyin Çoban]

.

Merhaba,
"yani ben pdf yolla dediğimde 3 farklı şekilde 3 sefer otomatik sırayla mail gidecek"
kısmını anlamadım.

2 için gitmesi gereken pdf örneklerini de yükleyebilir misiniz.

.

 

[search77]

Emir bey,
Aslında yapmak istediğim çok basit ama ben anlatamamış olabilirim.
Yani amacım döngü kurmak onu başaramadım.
sayfa2 de ID başlığı dışındaki hücrelerde formül var, ID ye sayfa 1 den kod başlığı altından sırasıyla değerleri aldıkça sağ taraftaki hücreler formüllü olduğu için değişiyor zaten.
sonra bu sayfayı PDF olarak mail atacak, ben aslında kodu bu şekilde yazdım,
sadece döngü kuramadım ID başlığı altına değeri manuel verip tek tek yollamak istemiyorum, tek seferde gitsin istiyorum.
İnşallah anlatabilmişimdir, şimdiden çok çok teşekkür ler

 

[Emir Hüseyin Çoban]

.
Yapılabilir...

Şu kısmı da netleştirelim.
3 ders notu için pdf ekine gerek var mı. Direk mail metin gövdesine yazabiliriz.
Yoksa bu sayfada daha sonra başka bilgiler olacak mı.

.

 

[search77]

Evet tablo aslında bayağı büyük, mail ekinde bu nedenle istemiyorum,
çok tşk ler

 

[Emir Hüseyin Çoban]

.

Sub kod()

Dim S1 As Worksheet: Set S1 = Sheets("Sayfa1")
Dim S2 As Worksheet: Set S2 = Sheets("Sayfa2")

For a = 2 To S1.Cells(Rows.Count, "A").End(3).Row

S2.Range("A2") = S1.Cells(a, "A")

yol1 = CreateObject("WScript.Shell").specialfolders("Desktop")
yol2 = Replace(yol1, "Desktop", "Documents") & "\" & S2.Range("A2") & "_" & Format(Now, "ddmmyyhhmmss") & ".pdf"
S2.ExportAsFixedFormat Type:=xlTypePDF, Filename:=yol2

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

    With xlMail
        .to = S1.Cells(a, "B").Value
        .CC = S1.Cells(a, "C").Value
        .Subject = "Konu"
        .Attachments.Add yol2
        .Importance = 2
        .Save
        .Send
    End With
    
    Set xlMail = Nothing
    Set xlOutlook = Nothing
    Kill yol2


Next a

End Sub

.

 

[search77]

Emir Hüseyin Bey,
Elinize kolunuza emeğinize sağlık 10 numara olmuş çok teşekkür ederim.
Syg.

 

[search77]

Emir Hüseyin Bey,
Son birşey daha sorulan, burada macro hemen sırasıyla mailleri atıyor ben burda atmadan önce bir kontrol koyma şansım var mı, yani evet hayır gibi
Ben okey deyince mail gitsin her seferinde bana sorsun,
teşekkür ederim

 

[Emir Hüseyin Çoban]

.

Sub kod()

Dim S1 As Worksheet: Set S1 = Sheets("Sayfa1")
Dim S2 As Worksheet: Set S2 = Sheets("Sayfa2")

sor = MsgBox("Mail Göndermek İstediğinize Emin Misiniz?", vbYesNo)
If sor = vbNo Then Exit Sub

For a = 2 To S1.Cells(Rows.Count, "A").End(3).Row

S2.Range("A2") = S1.Cells(a, "A")

yol1 = CreateObject("WScript.Shell").specialfolders("Desktop")
yol2 = Replace(yol1, "Desktop", "Documents") & "\" & S2.Range("A2") & "_" & Format(Now, "ddmmyyhhmmss") & ".pdf"
S2.ExportAsFixedFormat Type:=xlTypePDF, Filename:=yol2

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

    With xlMail
        .to = S1.Cells(a, "B").Value
        .CC = S1.Cells(a, "C").Value
        .Subject = "Konu"
        .Attachments.Add yol2
        .Importance = 2
        .Save
        .Send
    End With
    
    Set xlMail = Nothing
    Set xlOutlook = Nothing
    Kill yol2


Next a

End Sub

.

 

[search77]

Peki her seferinde sorabilir mi yani döngüyü her farklı PDF için çalıştırdığında hepsinde sorsun, bunda sadece ilk seferde soruyor
tekrar tşk ederim

 

[Emir Hüseyin Çoban]

Sub kod()

Dim S1 As Worksheet: Set S1 = Sheets("Sayfa1")
Dim S2 As Worksheet: Set S2 = Sheets("Sayfa2")

For a = 2 To S1.Cells(Rows.Count, "A").End(3).Row

S2.Range("A2") = S1.Cells(a, "A")

sor = MsgBox(S2.Range("A2") & Chr(10) & "Mail Göndermek İstediğinize Emin Misiniz?", vbYesNo, "")
If sor = vbNo Then
Else

yol1 = CreateObject("WScript.Shell").specialfolders("Desktop")
yol2 = Replace(yol1, "Desktop", "Documents") & "\" & S2.Range("A2") & "_" & Format(Now, "ddmmyyhhmmss") & ".pdf"
S2.ExportAsFixedFormat Type:=xlTypePDF, Filename:=yol2

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

    With xlMail
        .to = S1.Cells(a, "B").Value
        .CC = S1.Cells(a, "C").Value
        .Subject = "Konu"
        .Attachments.Add yol2
        .Importance = 2
        .Save
        .Send
    End With
    
    Set xlMail = Nothing
    Set xlOutlook = Nothing
    Kill yol2

End If
Next a

End Sub

 

[search77]

Süpersiniz tam dediğim gibi oldu, son birşey
ben mail içeriği ekledim
.Body = “Merhaba,Ekli Çalışmanız bu şekildedir. Syg.” şeklinde
fakat outlook içinde direk böyle uzun çıkıyor şöyle aşağıdaki biçimde çıkabilir mi
Merhaba,
Ekli Çalışmanız bu şekildedir.
Syg.

 

[Emir Hüseyin Çoban]

.Body = "Merhaba," & Chr(10) & "Ekli Çalışmanız bu şekildedir." & Chr(10) & "Syg."

 

[search77]

Sizi çok yordum, her şey için çok çok teşekkür ederim, emeğinize sağlık
Syg.