pdf yaparak otomatik mail gönderme

C

cem116

Katılım
12 Kasım 2010
Mesajlar
195
Excel Vers. ve Dili
2007 türkçe
Altın Üyelik Bitiş Tarihi
14-07-2022
Herkese merhaba. Üzerinde çalıştığım excel dosyasını pdf olarak outlook üzerinden makro aracılığıyla otomatik olarak göndermek istiyorum. Kod yazma konusunda pek bilgim yok internette ve kıymetli forumumuzda yaptığım araştırma neticesinde otomatik mail gönderme konusunda tam olarak işimi gören bir kod buldum. Ancak bu kod, dosyamı yine excel olarak gönderiyor. Ben ise pdf e dönüştürmesini istiyorum. Aşağıda paylaştığım kodu dosyayı pdf olarak gönderecek şekilde düzenleyebilir misiniz acaba ? Bir de eğer mümkünse, " mail gönderilecek onaylıyor musunuz?" şeklinde bir ilk mesaj, bir de işlem bittiğinde "mail gönderildi" şeklinde bir mesaj kutusu olabilirse çok iyi olur. üstatlara şimdiden teşekkürler...

Sub Email_CurrentWorkBook()
'Gönderilecek e-mail bilgilerini değiştirmeyi unutmayın...
Dim Makro As Object
Dim Mail As Object
Set Makro = CreateObject("Outlook.Application")
Set Mail = Makro.CreateItem(0)
On Error Resume Next
With Mail
.To = "olanoldusallagitsin@hotmail.com"
.CC = "olanoldu@hotmail.com"
.BCC = "olan@hotmail.com "
.Subject = "deneme dosyası"
.Body = "olanoldusallagitsin.com"
.Attachments.Add ActiveWorkbook.FullName
.Send
End With
On Error GoTo 0
Set Mail = Nothing
Set Makro = Nothing
End Sub
 
C

cem116

Katılım
12 Kasım 2010
Mesajlar
195
Excel Vers. ve Dili
2007 türkçe
Altın Üyelik Bitiş Tarihi
14-07-2022
Destek olabilecek kimse var mı acaba ?
 
C

cem116

Katılım
12 Kasım 2010
Mesajlar
195
Excel Vers. ve Dili
2007 türkçe
Altın Üyelik Bitiş Tarihi
14-07-2022
Teşekkürler, inceliyorum şimdi hemen.
 
C

cem116

Katılım
12 Kasım 2010
Mesajlar
195
Excel Vers. ve Dili
2007 türkçe
Altın Üyelik Bitiş Tarihi
14-07-2022
Sayın Korhan Ayhan, öncelikle ilginiz için teşekkürler. Ancak şöyle bir durum söz konusu, ben bahsettiğiniz linkteki konuyu inceledim ve

Sub PDF_KAYDET()
If Range("AX18").Value = "" Then
MsgBox "Lütfen dosya adını yazınız!", vbCritical
Exit Sub
End If

Yol = CreateObject("WScript.Shell").SpecialFolders("Desktop")
Dosya_Adi = Range("AX18").Value & ".pdf"

Range("Print_Area").ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=Yol & "\" & Dosya_Adi, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False

MsgBox "Dosyanız kayıt edilmiştir."
End Sub

Sub MAIL_GONDER()
Dim Uygulama As Object
Dim Yeni_Mail As Object

If Range("AX18").Value = "" Then
MsgBox "Lütfen dosya adını yazınız!", vbCritical
Exit Sub
End If

Yol = CreateObject("WScript.Shell").SpecialFolders("Desktop")
Dosya_Adi = Range("AX18").Value & ".pdf"

Range("Print_Area").ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=Yol & "\" & Dosya_Adi, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False

Set Uygulama = CreateObject("Outlook.Application")
Set Yeni_Mail = Uygulama.CreateItem(0)

With Yeni_Mail
.Subject = Range("AX14").Value
.Body = Range("AX21").Value
.Attachments.Add Yol & "\" & Dosya_Adi
.Save
If Range("AX10").Value = "" Then
.To = ""
.Display
Else
.To = Range("DN17").Value
.Send
MsgBox "Mail gönderildi."
End If
End With

Set Uygulama = Nothing
Set Yeni_Mail = Nothing
End Sub


Bu kodlara ulaştım. Ancak bunu kullandığımda outlook açılıyor, dosya pdf olarak kaydedilip maile ekleniyor ama orada kalıyor. Bir başka sorun da bu kodlar ilgili arkadaşın hazırladığı dosyayla uyumlu. benim yukarda paylaştığım kod ise daha farklı. Bu nedenle bu kodlar üzerinden destek olabilirseniz sevinirim... Yardımlarınız için şimdiden teşekkürler..
 
Korhan Ayhan

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
41,438
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
İlgilenen olmazsa müsait olduğumda (akşamları) yardımcı olmaya çalışırım.
 
C

comp_wolf

Altın Üye
Katılım
15 Eylül 2012
Mesajlar
72
Excel Vers. ve Dili
2010 türkçe
Altın Üyelik Bitiş Tarihi
01-02-2025
Üstat bu kodu dene ben kullanıyorum... pdf olarak değilde ekran çalışma alanının resmini gönderiyor.
Private Sub CommandButton3_Click()
'MAİL GÖNDER BUTONU
ActiveSheet.Unprotect "1453" 'çalışma sayfası kilidini kaldır
If [AJ15].Value = "" Then 'gönderilecek mail adresinin satırı boş ise uyarıyor.
MsgBox "ÖNCE GÖNDERİLECEK MAİL ADRESİNİ YAZINIZ LÜTFEN...", vbQuestion, "! ! !"
GoTo 10
Else
End If
Dim Sayfa As Worksheet
Dim Form As Range
Dim Sayfa1Form As Range
If Cells(13, 36) = "" Then GoTo HATA ' mail konu başlığı
On Error GoTo HATA
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
saydir = WorksheetFunction.CountIf(Range("A:AD"), "<>") + 1 ' çalışma alanını belirle
Sayfa1Formu = "A1:" & "AD" & saydir
Set Form = Worksheets("Sayfa1").Range(Sayfa1Formu)
Set Sayfa = ActiveSheet
With Form
.Parent.Select
Set Sayfa1Form = ActiveCell
.Select
ActiveWorkbook.EnvelopeVisible = True
With .Parent.MailEnvelope
.Introduction = " _ TARAFINDAN TASARLANMIŞTIR." 'mail listesi genel başlığı
With .Item
.To = Cells(15, 36) 'gönderilecek mail adresinin girilecek satırı
.CC = Cells(17, 36) ' gönderen mail adresinin girilecek satırı
.Subject = Cells(13, 36) ' mail konu başlığı
.bcc = "mudur@ ... .com.tr" ' bilgi maili kime gidecekse onun mailini yazabilirsin
.Send
End With
End With
Sayfa1Form.Select
End With
Sayfa.Select
HATA:
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
10: Sayfa1.Activate
ActiveSheet.Protect Password:="1453"
Range("G5").Activate
End Sub
 
Son düzenleme:
C

cem116

Katılım
12 Kasım 2010
Mesajlar
195
Excel Vers. ve Dili
2007 türkçe
Altın Üyelik Bitiş Tarihi
14-07-2022
comp_wolf' Alıntı:
Üstat bu kodu dene ben kullanıyorum... pdf olarak değilde ekran çalışma alanının resmini gönderiyor.
Private Sub CommandButton3_Click()
'MAİL GÖNDER BUTONU
ActiveSheet.Unprotect "1453" 'çalışma sayfası kilidini kaldır
If [AJ15].Value = "" Then 'gönderilecek mail adresinin satırı boş ise uyarıyor.
MsgBox "ÖNCE GÖNDERİLECEK MAİL ADRESİNİ YAZINIZ LÜTFEN...", vbQuestion, "! ! !"
GoTo 10
Else
End If
Dim Sayfa As Worksheet
Dim Form As Range
Dim Sayfa1Form As Range
If Cells(13, 36) = "" Then GoTo HATA ' mail konu başlığı
On Error GoTo HATA
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
saydir = WorksheetFunction.CountIf(Range("A:AD"), "<>") + 1 ' çalışma alanını belirle
Sayfa1Formu = "A1:" & "AD" & saydir
Set Form = Worksheets("Sayfa1").Range(Sayfa1Formu)
Set Sayfa = ActiveSheet
With Form
.Parent.Select
Set Sayfa1Form = ActiveCell
.Select
ActiveWorkbook.EnvelopeVisible = True
With .Parent.MailEnvelope
.Introduction = " _ TARAFINDAN TASARLANMIŞTIR." 'mail listesi genel başlığı
With .Item
.To = Cells(15, 36) 'gönderilecek mail adresinin girilecek satırı
.CC = Cells(17, 36) ' gönderen mail adresinin girilecek satırı
.Subject = Cells(13, 36) ' mail konu başlığı
.bcc = "mudur@ ... .com.tr" ' bilgi maili kime gidecekse onun mailini yazabilirsin
.Send
End With
End With
Sayfa1Form.Select
End With
Sayfa.Select
HATA:
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
10: Sayfa1.Activate
ActiveSheet.Protect Password:="1453"
Range("G5").Activate
End Sub
Genişletmek için tıkla ...

Çok tekkürler. Yoğunluktan ancak girebildim foruma. Henüz denemedim ama en azından bir teşekkür edeyim ilginize diye, cevap yazmak istedim. Çok sağ olun.
 
C

comp_wolf

Altın Üye
Katılım
15 Eylül 2012
Mesajlar
72
Excel Vers. ve Dili
2010 türkçe
Altın Üyelik Bitiş Tarihi
01-02-2025
cem116' Alıntı:
Çok tekkürler. Yoğunluktan ancak girebildim foruma. Henüz denemedim ama en azından bir teşekkür edeyim ilginize diye, cevap yazmak istedim. Çok sağ olun.
Genişletmek için tıkla ...
Sorun değil. ben kullanıyorum 5 aydır sorunsuz çalışıyor. inşallah sizde de sorunsuz çalışır. rica ederim çok teşekkürler iyi günler :)
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst