AccessTr.neT
Outlook Mail Yollama(logolu) - Baskı Önizleme

+- AccessTr.neT (https://accesstr.net)
+-- Forum: Microsoft Excel (https://accesstr.net/forum-microsoft-excel.html)
+--- Forum: Excel Örnekleri ve Uygulamaları (https://accesstr.net/forum-excel-ornekleri-ve-uygulamalari.html)
+--- Konu Başlığı: Outlook Mail Yollama(logolu) (/konu-outlook-mail-yollama-logolu.html)



Outlook Mail Yollama(logolu) - feraz - 15/05/2021

Merhaba.

Youtubeden bulup düzenledim.
İmza yerine Logo ekler.

Outlook htmlbody ile yapıldı.
Outlook ayarlarından gönderAl ile gönderilmeli.Yada ayarlardan otomatik seçilebilir bu ayar outlook kapatılırken.
Koda mailler yollanınca outllok açılması koduda ekledim.

Koda ilaveler yapılabilir.Orjinal videoyuda ekledim.

Umarım işe yarar üyelerin.

[Resim: do.php?img=11038]
https://resim.accesstr.net/do.php?img=11038




Private Sub CommandButton1_Click()
Dim dosyaAdLogo As String
Dim outlookapp As Object
Dim outlookmailitem As Object
Dim ek_Ekle As Object
Dim yol As String
Dim son As Long
Dim ek As String
Dim x As Long

x = 2
If outlookAcikmi = True Then
    MsgBox "Outlook kapat ve tekrar calistir..", vbCritical, "Hata"
    Exit Sub
End If

With ThisWorkbook.Sheets("Sayfa1")
    Do While .Cells(x, 1).Value <> ""
        Set outlookapp = CreateObject("Outlook.Application")
        Set outlookmailitem = outlookapp.createitem(0)
        Set ek_Ekle = outlookmailitem.Attachments
        yol = ThisWorkbook.path & Application.PathSeparator
        dosyaAdLogo = "Bayrak.png"
        ek = yol & .Cells(x, 3).Value
       
        outlookmailitem.To = .Cells(x, 1).Value
        outlookmailitem.Subject = .Cells(x, 2).Value
        outlookmailitem.Attachments.Add yol & dosyaAdLogo, 0
       
        outlookmailitem.HTMLBody = _
            "Sayin  " & .Cells(x, 4).Value & "<br>" _
            & "<br> xxxxxxx<br>" _
            & "<br> yyyyyyy <br> " _
            & "<br> zzzzzzz<br><br><br>" _
            & " <br> <img src='" & dosyaAdLogo & "'" & "width='150' height='100'> "
               
        ek_Ekle.Add (ek)
        outlookmailitem.display
        Application.Wait (Now + TimeSerial(0, 0, 3))
    '        outlookmailitem.send
        Application.Wait (Now + TimeSerial(0, 0, 3))
        son = son + 1
        adres = vbNullString
        x = x + 1
        Set outlookapp = Nothing
        Set outlookmailitem = Nothing
    Loop
End With
OutlookAc
End Sub

Public Sub OutlookAc()
    Dim ws As Object
    Dim sPath As String
    Set ws = CreateObject("WScript.Shell")
    sPath = ws.RegRead("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\OUTLOOK.EXE\")
    Set ws = Nothing
    Call Shell(sPath)
End Sub

Function outlookAcikmi() As Boolean
    Dim objOutlook As Object
    outlookAcikmi = False
    On Error Resume Next
    Set objOutlook = GetObject(, "Outlook.Application")
    If Not objOutlook Is Nothing Then
        outlookAcikmi = True
    End If
    On Error GoTo 0
    Set objOutlook = Nothing
End Function



RE: Outlook Mail Yollama(logolu) - Oğuz Türkyılmaz - 16/05/2021

@Teşekkürler @feraz Hocam.


RE: Outlook Mail Yollama(logolu) - feraz - 16/05/2021

Rica ederim abey Img-grin
Daha önceki yaptığımız resmi kopyalama yerine klasördeki bir resmi logo alıyor ve daha kullanışlı geldi.