Skip to main content

AccessTr.neT


Outlook Mail Yollama(logolu)

Outlook Mail Yollama(logolu)

#1
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



Visual Basic Code
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

Visual Basic Code
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

Visual Basic Code
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
.rar Email htmlbody ve resim ekleme dosya ilede(outlook).rar (Dosya Boyutu: 95,43 KB | İndirme Sayısı: 7)
Cevapla
#2
@Teşekkürler @feraz Hocam.
Access Çekirgesi 
[Resim: img-cray.gif]


Cevapla
#3
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.
Cevapla

Bir hesap oluşturun veya yorum yapmak için giriş yapın

Yorum yapmak için üye olmanız gerekiyor

ya da