Makro ile pdf dosyasını seçerek maille gönderme

muyat · 19 Nisan 2020

Merhaba makro ile mail gönderebiliyorum.Gönderdigim mailde bir adet word ve 1 adet ppt dosyası standart olarak var.
Ekler bölümüne aşagıdaki kodları yazdım.

Kod:

myAttachments.Add "C:\Users\" & Environ$("UserName") & "\Desktop\konya1\gorevler.doc"
myAttachments.Add "C:\Users\" & Environ$("UserName") & "\Desktop\konya1\dikkat-edilecek-hususlar.ppt"

Buraya kadar sorun yok...Program içinde bir dikdörtgen şekle tıkladıgımda mail gönderimini yapıyorum
İstedigim şey ise artık şu:
Makro çalıştıgında bir pencere açılcak.Bu pencereden göz atarak (browse sanırım) göndermek istedigim 1 adet pdf dosyasını seçtigimde mailin ekler kısmına o seçtigim pdf dosyası da otomatik yerleşcek...Şayet öncelikle bu pdf dosyasını seçmezsem program "lütfen ek pdf dosyasını seçiniz"şeklinde uyarı vercek ve o dosya seçilmeden mail gönderilmeyecek.
Bu pdf dosyasıından yüzlerce oldugu için dosya malesef kişiden kişiye değişip içerigi sabit ve standart olmadıgı için değişken oluyor ve programda ek kısmına yazı ile yazamıyorum..O nedenle amacım bu dosyayı eklemeyi unutmamak.Bunu nasıl yapabilirim.Yardımcı olur musunuz?S

hmtstc · 19 Nisan 2020

şu şekilde dosya seçtirip yapabilirsiniz.
dosya adı boş ise de ek yok demektir çıkış yapar.
kendi dosyanıza uyarlayınız.

Dim fPath As String
Dim fdgPicker As FileDialog
fPath = ThisWorkbook.Path
ChDrive fPath
ChDir fPath
'Create a FileDialog object as a File Picker dialog.
Set fdgPicker = Application.FileDialog(msoFileDialogFilePicker)
With fdgPicker
.InitialView = msoFileDialogViewThumbnail
.Filters.Add "Dosya(*.pdf)", "*.pdf"
.FilterIndex = 1
If .Show = -1 Then
dosyaadı = fdgPicker.SelectedItems(1)
End If
End With
End Sub
''''

if dosyaadı = empty then
msgbox "Ek dosya seçiniz"
exit sub
end if

With OutLookMailItem
.To = Cells(i, 1).Value
.Subject = "Put your subject here"
.Body = "Put your body here"
Attach.Add dosyaadı
.Display 'for debugging
.Send
End With

Korhan Ayhan · 19 Nisan 2020

Deneyiniz.

C++:

Option Explicit

Sub Mail_Gonder()
    Dim PDF_Dosya As Variant
    Dim Outlook_App As Object
    Dim Outook_Mail As Object
    
    PDF_Dosya = Application.GetOpenFilename("PDF Files, *.pdf", 1, "Lütfen Maile Eklemek İçin PDF Dosyasını Seçiniz", True)
          
    If TypeName(PDF_Dosya) = "Boolean" Then
        MsgBox "Hiçbir dosya seçilmediği için mail gönderim işlemi iptal edilmiştir!", vbCritical
        Exit Sub
    End If
    
    On Error Resume Next
    Set Outlook_App = GetObject(, "Outlook.Application")
    On Error GoTo 0
    
    If Outlook_App Is Nothing Then Call Shell("Outlook.exe", vbHide)
    
    Set Outlook_App = CreateObject("Outlook.Application")
    Set OutLook_Mail = Outlook_App.CreateItem(0)

    Mesaj = "<Body Style=Font-Size:11pt;Font-Family:Calibri>Merhaba,<br><br>" & _
              "Görev tanımlarınız ekte bilgilerinize sunulmuştur.<br>" & _
              "<br><br>Saygılarımla.</Body>"

    On Error Resume Next
    
    With OutLook_Mail
        .Display
        .To = "deneme@gmail.com"
        .CC = ""
        .BCC = ""
        .Subject = "Görevler ve Dikkat Edilecek Hususlar"
        .HTMLBody = Mesaj & "<br>" & .HTMLBody
        .Attachments.Add PDF_Dosya
        .Attachments.Add "C:\Users\" & Environ$("UserName") & "\Desktop\konya1\gorevler.doc"
        .Attachments.Add "C:\Users\" & Environ$("UserName") & "\Desktop\konya1\dikkat-edilecek-hususlar.ppt"
        '.Send
    End With
    
    On Error GoTo 0

    Set OutLook_Mail = Nothing
    Set Outlook_App = Nothing
    
    MsgBox "Mail gönderim işlemi tamamlanmıştır.", vbInformation
End Sub

Makro ile pdf dosyasını seçerek maille gönderme

muyat

hmtstc

Korhan Ayhan

Administrator