Soru PDF Yap Mail Olarak Gönder

Korhan Ayhan · 28 Şubat 2021

Başka bir sorun var demek ki...

Şunu deneyiniz;

Outlook-Dosya-Seçenekler-Güven Merkezi-Güven Merkezi Ayarları adımlarını izleyin.

Açılan menüde "Programlı Erişim" seçeneğine tıklayın. En alttaki seçeneği seçip işlemi tamamlayın.

Bu işlemle otomatik gönderim işlemini virüs saldırısı olarak algılamamasını sağlamış oluyoruz.

Sonra kodu tekrar deneyiniz.

Bu ayardan sonra benim ilk paylaştığım hali ile kodu kullanabiliyor olmanız gerekir. (Yani #18 nolu mesajdaki işlemi yapmadan kodu denediğinizde çalışması gerekir.)

Eğer yine sonuç alamazsanız varsa geçici olarak virüs programınızı devre dışı bırakıp deneme yapınız.

Hsn55 · 28 Şubat 2021

Korhan bey bende o ayarlar pasif görünüyor. Seçim yapamıyorum

Korhan Ayhan · 28 Şubat 2021

Şirket bilgisayarıysa benim yapabileceğim bir şey yok maalesef. IT sorumlusu kısıtlama yapmış olabilir.

Hsn55 · 1 Mart 2021

Korhan bey işyerinde denedim . Gayet güzel çalışıyor. Outlok sayfası açılmadan direk gönderme olur mu?.

Korhan Ayhan · 1 Mart 2021

Kullandığınız bir imzanız varsa bunun çıkması için outlook sayfası açılıyor. Eğer imza kullanmıyorsanız aşağıdaki satırı silerseniz istediğiniz sonuca ulaşabilirsiniz.

.Display

Hsn55 · 1 Mart 2021

Belirttiğiniz satırı sildim yine açılıyor. Kullandığım imza yok .

Korhan Ayhan · 1 Mart 2021

Öncelikle gönderim işlemi için Outlook uygulamasının açık olması gerekir.

Önerdiğim kod kısaca şu işlemi yapıyor.

Outlook uygulaması açık değilse açıyor. Bu aşamada pencereler görünebilir.
Açıksa bir işlem yapmıyor. Açık olduğunda pencerelerin görünmemesi gerekir.

Sonra PDF olarak veriyi kaydediyor ve mail ekine ekleyip gönderiyor.

Hsn55 · 1 Mart 2021

Korhan bey sizin en son gönderdiğiniz kod çok kullanışlı ve hızlı . Birde aşağıda ki kodu revize edebilir misiniz. Masaüsütünde seçtiğimiz herhangi bir formattaki dosyayı ekleyip göndermek için kodu revize eder misiniz ?. Birde Korhan bey mail gönderdikten sonra numlock tuşu kapanıyor.

Kod:

Option Explicit

Sub MAIL_GONDER()
    
    Beep
On Error Resume Next
    
    Dim S1 As Worksheet, S2 As Worksheet
    Dim Uygulama As Object, Yeni_Mail As Object
    Dim Yol As String, Dosya_Adi As String, Son As Long
    
    Set S1 = Sheets("PDF")
    Set S2 = Sheets("VERİ")
    
    Yol = ThisWorkbook.Path & Application.PathSeparator
    Dosya_Adi = S2.Range("E3").Value & "-" & S2.Range("E7").Value & ".pdf"

    Son = S1.Cells(S1.Rows.Count, "B").End(xlUp).Row
    
    S1.Range("A1:AR" & Son).ExportAsFixedFormat Type:=xlTypePDF, _
    Filename:=Yol & Dosya_Adi, _
    Quality:=xlQualityStandard, _
    IncludeDocProperties:=True, _
    IgnorePrintAreas:=False, _
    OpenAfterPublish:=False
    
    On Error Resume Next
    Set Uygulama = GetObject(, "Outlook.Application")
    On Error GoTo 0
  
    If Uygulama Is Nothing Then Call Shell("Outlook.exe", vbHide)
  
    Set Uygulama = CreateObject("Outlook.Application")
    Set Yeni_Mail = Uygulama.CreateItem(0)

    With Yeni_Mail
        
        .To = Sheets("VERİ").Range("E9").Value
        .Subject = Sheets("VERİ").Range("E10").Value
        .HtmlBody = Sheets("VERİ").Range("E11").Value & vbCr & .HtmlBody
        .Attachments.Add Yol & "\" & Dosya_Adi
        .Save
        .Send
    End With
    
    Set S1 = Nothing
    Set S2 = Nothing
    Set Uygulama = Nothing
    Set Yeni_Mail = Nothing
    
    MsgBox Sheets("VERİ").Range("E9") & " Adresine Mail Gönderilmiştir", vbInformation
    
End Sub

Korhan Ayhan · 1 Mart 2021

Seçim sadece masaüstünden mi yapılacak?

Hsn55 · 1 Mart 2021

İlk açıldığında masaüstü çıkacak. Daha sonra başka yolları da seçebileceğiz.

Korhan Ayhan · 1 Mart 2021

Deneyiniz.

C++:

Option Explicit

Sub MAIL_GONDER()
    Dim S1 As Worksheet, S2 As Worksheet
    Dim Uygulama As Object, Yeni_Mail As Object
    Dim Yol As String, Secilen_Dosyalar As Variant, Dosya As Variant
    
    Set S1 = Sheets("PDF")
    Set S2 = Sheets("VERİ")
    
    Beep
    
    Yol = CreateObject("WScript.Shell").SpecialFolders("Desktop") & Application.PathSeparator
    ChDir Yol
    Secilen_Dosyalar = Application.GetOpenFilename(Title:="Lütfen mail olarak göndermek istediğiniz dosyaları seçiniz...", MultiSelect:=True)

    If IsArray(Secilen_Dosyalar) = False Then
        MsgBox "Dosya seçimi yapmadığınız için işlem iptal edilmiştir.", vbExclamation
        Exit Sub
    End If
    
    On Error Resume Next
    Set Uygulama = GetObject(, "Outlook.Application")
    On Error GoTo 0
  
    If Uygulama Is Nothing Then Call Shell("Outlook.exe", vbHide)
  
    Set Uygulama = CreateObject("Outlook.Application")
    Set Yeni_Mail = Uygulama.CreateItem(0)

    With Yeni_Mail
        .To = S2.Range("E9").Value
        .Subject = S2.Range("E10").Value
        .HtmlBody = S2.Range("E11").Value & vbCr & .HtmlBody
         For Each Dosya In Secilen_Dosyalar
            .Attachments.Add Dosya
         Next
        .Save
        .Send
    End With
    
    MsgBox S2.Range("E9") & " adresine mail gönderilmiştir", vbInformation
    
    Set S1 = Nothing
    Set S2 = Nothing
    Set Uygulama = Nothing
    Set Yeni_Mail = Nothing
End Sub

Hsn55 · 1 Mart 2021

Korhan bey teşekkür ederim.
Outlookta 1 den fazla hesap varsa gönderirken gönderen hesabı seçme durumu var mı?.

Korhan Ayhan · 1 Mart 2021

Seçebilirsiniz..

Deneyiniz. Kırmızı renkli sayı ile oynayarak hesap seçimi yapabilirsiniz.

Rich (BB code):

    With Yeni_Mail
        .SendUsingAccount = Uygulama.Session.Accounts.Item(2)
        .To = S2.Range("E9").Value
        .Subject = S2.Range("E10").Value
        .HtmlBody = S2.Range("E11").Value & vbCr & .HtmlBody
         For Each Dosya In Secilen_Dosyalar
            .Attachments.Add Dosya
         Next
        .Save
        .Send
    End With

Hsn55 · 2 Mart 2021

Korhan bey,
SendUsingAccount = Uygulama.Session.Accounts.Item(2)
Gönderenin hesabını Veri sayfadından E3 hücresinden alabilir mi?.

Hsn55 · 2 Mart 2021

Korhan bey merhabalar;
Aşağıdaki kodun işaretli kısmında hata veriyor.

Kod:

.SendUsingAccount = Uygulama.Session.Accounts.Item(2)

Kod:

Option Explicit
Sub MAIL_GONDERdosya()
    Dim S1 As Worksheet, S2 As Worksheet
    Dim Uygulama As Object, Yeni_Mail As Object
    Dim Yol As String, Secilen_Dosyalar As Variant, Dosya As Variant
  
    Set S1 = Sheets("PDF")
    Set S2 = Sheets("VERİ")
  
    Beep
  
    Yol = CreateObject("WScript.Shell").SpecialFolders("Desktop") & Application.PathSeparator
    ChDir Yol
    Secilen_Dosyalar = Application.GetOpenFilename(Title:="Lütfen mail olarak göndermek istediğiniz dosyaları seçiniz...", MultiSelect:=True)

    If IsArray(Secilen_Dosyalar) = False Then
        MsgBox "Dosya seçimi yapmadığınız için işlem iptal edilmiştir.", vbExclamation
        Exit Sub
    End If
  
    On Error Resume Next
    Set Uygulama = GetObject(, "Outlook.Application")
    On Error GoTo 0

    If Uygulama Is Nothing Then Call Shell("Outlook.exe", vbHide)

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

    With Yeni_Mail
        .SendUsingAccount = Uygulama.Session.Accounts.Item(2)
        .To = S2.Range("E9").Value
        .Subject = S2.Range("E10").Value
        .HtmlBody = S2.Range("E11").Value & vbCr & .HtmlBody
         For Each Dosya In Secilen_Dosyalar
            .Attachments.Add Dosya
         Next
        .Save
        .Send
    End With
  
    MsgBox S2.Range("E9") & " adresine mail gönderilmiştir", vbInformation
  
    Set S1 = Nothing
    Set S2 = Nothing
    Set Uygulama = Nothing
    Set Yeni_Mail = Nothing
End Sub

Korhan Ayhan · 2 Mart 2021

O kısmı şu şekilde deneyiniz.

Set .SendUsingAccount = Uygulama.Session.Accounts.Item(2)

Hsn55 · 2 Mart 2021

Şimdi çalıştı. Gönderen kişinin hesap seçme işini hücreden yapabilir miyiz. Örneğin E15 hücresine 1 yazdığımda gönderen 1. kişi olacak 2 yazdığımda diğer kişiye gidecek

Korhan Ayhan · 2 Mart 2021

Item numarası yerine hücre adresini yazmanız yeterli olacaktır.

Set .SendUsingAccount = Uygulama.Session.Accounts.Item(S2.Range("E15").Value)

Ek olarak sanırım aşağıdaki gibi de olabiliyor.

Veri sayfasında E15 hücresine mail adresini yazınız. Tabi bu hesabın tanımlı olması gerekiyor.

Set .SendUsingAccount = Uygulama.Session.Accounts(S2.Range("E15").Value)

Bu da başka bir alternatif;

C++:

    With Yeni_Mail
        .SentOnBehalfOfName = S2.Range("E15").Value
        .To = S2.Range("E9").Value
        .Subject = S2.Range("E10").Value
        .HtmlBody = S2.Range("E11").Value & vbCr & .HtmlBody
         For Each Dosya In Secilen_Dosyalar
            .Attachments.Add Dosya
         Next
        .Save
        .Send
    End With

Hsn55 · 3 Mart 2021

Korhan bey merhabalar;
Bu koda aşağıdaki kodu nasıl ilave edebiliriz ?

Kod:

Dim cevap As Integer
If MsgBox("  Mail Adresine Göndermek İstediğinizden Eminmi siniz?", vbYesNo + vbInformation) = vbNo Then Exit Sub
If cevap = vbNo Then
    MsgBox "Mail Gönderme İşleminiz iptal edilmiştir."
    Exit Sub
Else

Kod:

Sheets("VERİ").Range("E9") & " Mail Adresine Göndermek İstediğinizden Eminmi siniz?", vbYesNo + vbInformation) = vbNo Then Exit Sub

If cevap = vbNo Then

Korhan Ayhan · 3 Mart 2021

Aşağıdaki gibi düzenleyebilirsiniz.

C++:

Option Explicit

Sub MAIL_GONDER()
    Dim S1 As Worksheet, S2 As Worksheet
    Dim Uygulama As Object, Yeni_Mail As Object, Onay As Byte
    Dim Yol As String, Secilen_Dosyalar As Variant, Dosya As Variant
    
    Set S1 = Sheets("PDF")
    Set S2 = Sheets("VERİ")
    
    Beep
    
    Onay = MsgBox(S2.Range("E9") & " mail adresine göndermek istediğinize emin misiniz?", vbYesNo + vbDefaultButton2)
    If Onay = vbNo Then
        MsgBox "Mail gönderme işleminiz iptal edilmiştir.", vbExclamation
        Exit Sub
    End If
    
    Yol = CreateObject("WScript.Shell").SpecialFolders("Desktop") & Application.PathSeparator
    ChDir Yol
    Secilen_Dosyalar = Application.GetOpenFilename(Title:="Lütfen mail olarak göndermek istediğiniz dosyaları seçiniz...", MultiSelect:=True)

    If IsArray(Secilen_Dosyalar) = False Then
        MsgBox "Dosya seçimi yapmadığınız için işlem iptal edilmiştir.", vbExclamation
        Exit Sub
    End If
    
    On Error Resume Next
    Set Uygulama = GetObject(, "Outlook.Application")
    On Error GoTo 0
  
    If Uygulama Is Nothing Then Call Shell("Outlook.exe", vbHide)
  
    Set Uygulama = CreateObject("Outlook.Application")
    Set Yeni_Mail = Uygulama.CreateItem(0)

    With Yeni_Mail
        .SentOnBehalfOfName = S2.Range("E3").Value
        .To = S2.Range("E9").Value
        .Subject = S2.Range("E10").Value
        .HtmlBody = S2.Range("E11").Value & vbCr & .HtmlBody
         For Each Dosya In Secilen_Dosyalar
            .Attachments.Add Dosya
         Next
        .Save
        .Send
    End With
    
    MsgBox S2.Range("E9") & " adresine mail gönderilmiştir", vbInformation
    
    Set S1 = Nothing
    Set S2 = Nothing
    Set Uygulama = Nothing
    Set Yeni_Mail = Nothing
End Sub

Soru PDF Yap Mail Olarak Gönder

Korhan Ayhan

Administrator

Hsn55

Korhan Ayhan

Administrator

Hsn55

Korhan Ayhan

Administrator

Hsn55

Korhan Ayhan

Administrator

Hsn55

Korhan Ayhan

Administrator

Hsn55

Korhan Ayhan

Administrator

Hsn55

Korhan Ayhan

Administrator

Hsn55

Hsn55

Korhan Ayhan

Administrator

Hsn55

Korhan Ayhan

Administrator

Hsn55

Korhan Ayhan

Administrator