Makro ile pdf Kaydedilen dosyayı Mail Gönderme

[wesdesa]

Merhaba,
Sayfa üzerinde yazdırma alanı belirlenmiş bir alan var bu alana pdf ye çevir diye bir buton kodlaması yazdım ve çeviriyor çevirirken yazdırma alanı içerisindeki D6 hücresinden dosya kaydı yapacağı müşterinin adını otomatik çekiyor..Buraya kadar herşey normal bir buton kodlaması daha yaptım yine d12 deki mail adresine göre yazdırma sayfası içindeki kayıtlı olan dosyayı mail atmak istiyorum fakat Attachment yapacağım yerde dosya yolunu yazmam gerek ben yine müşteri adından çeksin istiyorum umarım anlatabilmişimdir…Cevabınızı bekliyorum teşekkürler..

 

[Erdem Akdemir]

Örnek dosyanızı ekleyebilir misiniz?

 

[wesdesa]

PDF kaydetmek için yazdığım kod bu,bunda sorun yok...

Sub PDFKaydet_Click()
dosya_adı = Cells(6, "D").Value
If dosya_adı = "" Then
MsgBox "Dosya adı yok"
Exit Sub
End If
a = MsgBox(" Kayıt etmek istiyormusunuz.?", vbYesNo + vbInformation, " Uyarı")
If a = vbYes Then
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, fileName:= _
ThisWorkbook.Path & "\" & dosya_adı, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
MsgBox "işlem tamam!"
End If
If a = vbNo Then
MsgBox "işlemi iptal ettiniz.!"
End If
End Sub

************************************************************
Mail göndermek için yazdığım kodda bu;
Amacım üst taraftaki pdf kaydet de sayfa içindeki hücreden müşteri adını alıp masaüstüne o müşteri adıyla kaydediyor fakat mail gönder dediğimde o dosyayı bulamıyor otomatik..

Sub Gonder_Click()
Dim OutlookUygulama As Object
Dim Mail As Object

Set OutlookUygulama = New Outlook.Application
Set Mail = OutlookUygulama.CreateItem(0)

With Mail
.To = Cells(12, 4)
.CC = "ilker.topkara@oksanoto.com"
.BCC = ""
.Subject = Cells(10, 4)
.Body = "Merhaba Sayın Yetkili," & vbCrLf & "" & vbCrLf & "İstemiş olduğunuz ürünlere ait fiyat teklifimiz ekte bilgilerinize sunulmuştur.Firmamızdan teklif almak suretiyle" & vbCrLf & "göstermiş olduğunuz ilgiye teşekkür eder, iyi çalışmalar dileriz."
.Attachments.Add ("C:\Users\user\Desktop\Oksan Alarm.pdf")
.Send
End With

Set Mail = Nothing
Set OutlookUygulama = Nothing
End Sub

Şimdiden teşekkür ederim..Saygılar...

 

[halit3]

Kodlarda Dosya yolunuz bu gözüküyor

ThisWorkbook.Path & "\" & Cells(6, "D").Value

yani mail gönderen bu bölüme

.Attachments.Add

ekliyeceksiniz aşağıdaki gibi

.Attachments.Add ThisWorkbook.Path & "\" & Cells(6, "D").Value

 

[wesdesa]

Yardımınız için teşekkürler fakat,

Bu kod zaten pdf kaydetmek için bunda sorun yok benim sıkıntım,

.Attachments.Add ("C:\Users\user\Desktop\Oksan Alarm.pdf") bu kısımda burayı ne yapmam
gerek kaydedilmiş dosyayı çekebilsin..

 

[halit3]

Yardımınız için teşekkürler fakat,

Bu kod zaten pdf kaydetmek için bunda sorun yok benim sıkıntım,

.Attachments.Add ("C:\Users\user\Desktop\Oksan Alarm.pdf") bu kısımda burayı ne yapmam
gerek kaydedilmiş dosyayı çekebilsin..

siz pdf dosyasını mail olarak göndermiyecekmisiniz.
gönderecekseniz yukarıdaki anlattığım şekilde bir deneyiniz.

 

[wesdesa]

Abi yeniyim dosya yükleyemedim.. mail adresinizi verirseniz mail atayım

 

[asazak]

Arkadaşlar merhaba oluşturduğum tabloda günlük girdiğim verilerden tarihe göre (B3:J20) arasına değer geliyor. b3:j20 aralığında formül var değer geldiğinde formül silinsin yardım edebilirmisiniz.

 

[wesdesa]

halit3 abi sağol,

pdf göndereceğim fakat iki ayrı buton var biri pdf kaydetrmek için diğeri mail göndermek için bu durumda sizin gönderdiğiniz kodu mail göndermek istediğim koda yazdığımda hata alıyorum;
mail göndermek istediğim kodlamanın kodu .Attachments.Add ("C:\Users\user\Desktop\Oksan Alarm.pdf") bana bu lazım

pdf olarak kaydettiğimin koduda ThisWorkbook.Path & "\" & dosya_adı

 

[halit3]

iki kodu birleştirdim.

Sub Gonder_Click()

dosya_adı = Cells(6, "D").Value
If dosya_adı = "" Then
MsgBox "Dosya adı yok"
Exit Sub
End If

a = MsgBox(" Kayıt etmek istiyormusunuz.?", vbYesNo + vbInformation, " Uyarı")

If a = vbNo Then
MsgBox "işlemi iptal ettiniz.!"
Exit Sub
End If

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
ThisWorkbook.Path & "\" & dosya_adı, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False


Dim OutlookUygulama As Object
Dim Mail As Object

Set OutlookUygulama = New Outlook.Application
Set Mail = OutlookUygulama.CreateItem(0)

With Mail
.To = Cells(12, 4)
.CC = "ilker.topkara@oksanoto.com"
.BCC = ""
.Subject = Cells(10, 4)
.Body = "Merhaba Sayın Yetkili," & vbCrLf & "" & vbCrLf & "İstemiş olduğunuz ürünlere ait fiyat teklifimiz ekte bilgilerinize sunulmuştur.Firmamızdan teklif almak suretiyle" & vbCrLf & "göstermiş olduğunuz ilgiye teşekkür eder, iyi çalışmalar dileriz."
.Attachments.Add ThisWorkbook.Path & "\" & dosya_adı
.Send
End With

Set Mail = Nothing
Set OutlookUygulama = Nothing
MsgBox "işlem tamam!"

End Sub

 

[wesdesa]

abi verdiğin kodu kopyaladım fakat Run Time Error Automation Error diye bir hata verdi.. Ne yapmam gerek..

 

[halit3]

abi verdiğin kodu kopyaladım fakat Run Time Error Automation Error diye bir hata verdi.. Ne yapmam gerek..

Ben sadece iki kodunuzu birleştirdim.
Böyle cevap vermek zor dosya olmadan

Siz herhalde bu kodları farklı dosyalarda kullanıyorsunuz.
ve bu dosyaların adresleride farklı yerlerde olduğundan bu işlemler yapılamıyor gibi geldi bana

 

[wesdesa]

halit3 abi bu kodu yukledim sağol fakat şimdide Run-time error automation error hatası alıyorum ama dosyayı kaydediyor..

 

[halit3]

halit3 abi bu kodu yukledim sağol fakat şimdide Run-time error automation error hatası alıyorum ama dosyayı kaydediyor..

Siz mail gönderme koduyla maillerinizi gönderebiliyormuydunuz.

 

[wesdesa]

abi farklı değil aynı sayfa için de iki tane buton üzerinde kullanıyorum biriyle pdf kayıt yapıyordum diğeriyle mail gönderiyordum kayıt yaptığım dosyayı mail atamadığım için sıkıntım vardı -...Çünkü kayıt yaptığım dosya adını sayfanın içinde müşteri adı kısmından alıyorum doğal olarak da mail atarken dosya adını gösteremiyorum sorun bu mail atarken nasıl aynı dosyayı göstereceğim..

 

[wesdesa]

evet gönderebiliyordum fakat belirli bir yerdeki belirli bir dosyayı gönderebiliyordum... benim mail adresim diyosan@hotmail.com istersen boş mail at dosyayı göndereyim sana..

 

[halit3]

evet gönderebiliyordum fakat belirli bir yerdeki belirli bir dosyayı gönderebiliyordum... benim mail adresim diyosan@hotmail.com istersen boş mail at dosyayı göndereyim sana..

Şu kodu bir dene mail gönderebiliyormuzunuz.
Eğer mail adresinizdeki hesabınız gmail ise
kodun sadece kırmızı yerlerine kullanıcı adı ve parolayı giriniz.

kod:

Sub mailgönder()
'On Error Resume Next
dosya_adı = Cells(6, "D").Value

Set objEmail = CreateObject("CDO.Message")

kullanici_sahibi = "[COLOR="red"]kullanıcı@hotmail.com[/COLOR]" '"kullanıcı@hotmail.com"
kullanici_parola = "[COLOR="Red"]123456[/COLOR]" '"parola"

objEmail.From = "ilker.topkara@oksanoto.com" ' Gönderilen e-mail adresi
objEmail.To = Cells(12, 4) ' Gönderilecek e-mail adresi

objEmail.Subject = Cells(10, 4)
objEmail.Textbody = "Merhaba Sayın Yetkili," & vbCrLf & "" & vbCrLf & "İstemiş olduğunuz ürünlere ait fiyat teklifimiz ekte bilgilerinize sunulmuştur.Firmamızdan teklif almak suretiyle" & vbCrLf & "göstermiş olduğunuz ilgiye teşekkür eder, iyi çalışmalar dileriz." '"Test Text Body"

'objEmail.Addattachment ThisWorkbook.Path & "\" & dosya_adı '"C:\baba.txt" ' eğer isterseniz eklenecek dosya
With objEmail.Configuration.Fields

.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = kullanici_sahibi '"kullanıcı@hotmail.com"
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = kullanici_parola '"parola"
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465
.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
.Update

End With
objEmail.Send

MsgBox "işlem tamam.", vbApplicationModal, "Bilgilendirme!"


End Sub

 

[wesdesa]

halit3 abi,başını ağrıttım gerçekten özür ama hakikaten çakıldım kusura bakma gönderdiğin kod olmadı;
birkez daha aşağıda anlatmaya çalıştım;

Aşağıdaki kod bir butona bağlı olarak çalışıyor.. butona bastığımda sayfa içerisindeki D6 hücrese yazdığım müşteri ismini otomatik olarak dosya adı yapıp pdf olarak masaüstüne kaydediyor bunda sıkıntım yok bu kod doğru çalışıyor...

PDF Kodu
Private Sub PDFKaydet_Click()
dosya_adı = Cells(6, "D").Value
If dosya_adı = "" Then
MsgBox "Dosya adı yok"
Exit Sub
End If
a = MsgBox(" Kayıt etmek istiyormusunuz.?", vbYesNo + vbInformation, " Uyarı")
If a = vbYes Then
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, fileName:= _
ThisWorkbook.Path & "\" & dosya_adı, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
MsgBox "işlem tamam!"
End If
If a = vbNo Then
MsgBox "işlemi iptal ettiniz.!"
End If
End Sub

********************************************************************************
Aşağıdaki kod ise outlook üzerinden kayıtlı şirket mail adresimden mail göndermek için butona bağlı,aslında iki kodda normalde sorunsuz çalışıyor,sadece ilk kodlamada hani müşteri adını hücreden çekip kaydetmişti ya o kayıtlı dosyayı göndermek için ".Attachments.Add ("C:\Users\user\Desktop\OKSAN ALARM TEKLIFF.pdf") " bu kodu değiştirmem gerek çünkü bu kodda belirli bir dosyayı dosya yolunu göstererek mail ekleyip gönderebiliyorum benim istediğim kayıt edilmiş o isimli dosyayı mail ek yapabilmek..

Sub Gonder_Click()
Dim OutlookUygulama As Object
Dim Mail As Object

Set OutlookUygulama = New Outlook.Application
Set Mail = OutlookUygulama.CreateItem(0)

With Mail
.To = Cells(12, 4)
.CC = "ilker.topkara@oksanoto.com"
.BCC = ""
.Subject = Cells(10, 4)
.Body = "Merhaba Sayın Yetkili," & vbCrLf & "" & vbCrLf & "İstemiş olduğunuz ürünlere ait fiyat teklifimiz ekte bilgilerinize sunulmuştur.Firmamızdan teklif almak suretiyle" & vbCrLf & "göstermiş olduğunuz ilgiye teşekkür eder, iyi çalışmalar dileriz."
.Attachments.Add ("C:\Users\user\Desktop\OKSAN ALARM TEKLIFF.pdf")
.Send
End With

Set Mail = Nothing
Set OutlookUygulama = Nothing
End Sub

 

[halit3]

halit3 abi,başını ağrıttım gerçekten özür ama hakikaten çakıldım kusura bakma gönderdiğin kod olmadı;
birkez daha aşağıda anlatmaya çalıştım;

Aşağıdaki kod bir butona bağlı olarak çalışıyor.. butona bastığımda sayfa içerisindeki D6 hücrese yazdığım müşteri ismini otomatik olarak dosya adı yapıp pdf olarak masaüstüne kaydediyor bunda sıkıntım yok bu kod doğru çalışıyor...

PDF Kodu
Private Sub PDFKaydet_Click()
dosya_adı = Cells(6, "D").Value
If dosya_adı = "" Then
MsgBox "Dosya adı yok"
Exit Sub
End If
a = MsgBox(" Kayıt etmek istiyormusunuz.?", vbYesNo + vbInformation, " Uyarı")
If a = vbYes Then
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, fileName:= _
ThisWorkbook.Path & "\" & dosya_adı, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
MsgBox "işlem tamam!"
End If
If a = vbNo Then
MsgBox "işlemi iptal ettiniz.!"
End If
End Sub

********************************************************************************
Aşağıdaki kod ise outlook üzerinden kayıtlı şirket mail adresimden mail göndermek için butona bağlı,aslında iki kodda normalde sorunsuz çalışıyor,sadece ilk kodlamada hani müşteri adını hücreden çekip kaydetmişti ya o kayıtlı dosyayı göndermek için ".Attachments.Add ("C:\Users\user\Desktop\OKSAN ALARM TEKLIFF.pdf") " bu kodu değiştirmem gerek çünkü bu kodda belirli bir dosyayı dosya yolunu göstererek mail ekleyip gönderebiliyorum benim istediğim kayıt edilmiş o isimli dosyayı mail ek yapabilmek..

Sub Gonder_Click()
Dim OutlookUygulama As Object
Dim Mail As Object

Set OutlookUygulama = New Outlook.Application
Set Mail = OutlookUygulama.CreateItem(0)

With Mail
.To = Cells(12, 4)
.CC = "ilker.topkara@oksanoto.com"
.BCC = ""
.Subject = Cells(10, 4)
.Body = "Merhaba Sayın Yetkili," & vbCrLf & "" & vbCrLf & "İstemiş olduğunuz ürünlere ait fiyat teklifimiz ekte bilgilerinize sunulmuştur.Firmamızdan teklif almak suretiyle" & vbCrLf & "göstermiş olduğunuz ilgiye teşekkür eder, iyi çalışmalar dileriz."
.Attachments.Add ("C:\Users\user\Desktop\OKSAN ALARM TEKLIFF.pdf")
.Send
End With

Set Mail = Nothing
Set OutlookUygulama = Nothing
End Sub

Böyle sonuca ulaşamıyacağız
dosyanızın bir örneğini buraya yükleyin bakalım altın üye olmayanlar nasıl yüklüyorsa farklı konulara bakın onlar gibi yükleyebilirsiniz.

kayıt yaptığınız klasör adıda bu (ThisWorkbook.Path)
kayıt yaptığınız dosya adı bu (dosya_adı = Cells(6, "D").Value)

göndereceğin klasör yolunu ve dosya adını birleştiriyoruz ve mail adresine ekliyoruz burada negibi hata var anlayamadım hala olmuyor diyorsunuz.
mail dosya adı (ThisWorkbook.Path & "\" & dosya_adı)

siz birde bu kodları deneyin yanlız bu kodlar diğer kodların yanında olsun

Sub gönder()
PDFKaydet_Click
Gonder_Click
End Sub

 

[Korhan Ayhan]

Alternatif olarak aşağıdaki kodu denermisiniz.

Option Explicit

Dim Yol As String
Dim Dosya_Adi As String
Dim Outlook_App As Object
Dim Outlook_Mail As Object
Dim S1 As Worksheet, Onay As Byte

Sub PDF_KAYDET_MAIL_GONDER()
    Set Outlook_App = CreateObject("Outlook.Application")
    Set Outlook_Mail = Outlook_App.CreateItem(0)
    
    Set S1 = ActiveSheet
    
    Yol = ThisWorkbook.Path
    Dosya_Adi = Yol & "\" & S1.Cells(6, "D").Value
    ChDir Yol
        
    Onay = MsgBox("Kayıt edip mail göndermek istiyor musunuz?", vbExclamation + vbYesNo, "Uyarı")
    
    If Onay = vbYes Then
        S1.ExportAsFixedFormat Type:=xlTypePDF, _
        Filename:=Dosya_Adi, _
        Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, _
        OpenAfterPublish:=False
        
        With Outlook_Mail
            .To = S1.Cells(12, 4)
            .CC = "ilker.topkara@oksanoto.com"
            .BCC = ""
            .Subject = S1.Cells(10, 4)
            .Body = "Merhaba Sayın Yetkili," & vbCrLf & "" & vbCrLf & "İstemiş olduğunuz ürünlere ait fiyat teklifimiz ekte bilgilerinize sunulmuştur." & vbCrLf & vbCrLf & _
                    "Firmamızdan teklif almak suretiyle göstermiş olduğunuz ilgiye teşekkür eder, iyi çalışmalar dileriz."
            .Attachments.Add Dosya_Adi & ".pdf"
            .BodyFormat = 2
            .Save
            .Send
            '.Display
        End With
        
        MsgBox "İşleminiz tamamlanmıştır.", vbInformation
    
    Else
        
        MsgBox "İşleminiz iptal edilmiştir.", vbInformation
    
    End If
    
    Set S1 = Nothing
    Set Outlook_Mail = Nothing
    Set Outlook_App = Nothing
End Sub