Dosya eksız maıl gonderme

[kneehot]

Arkadaslar merhaba. Daha yeni buna benzer bir konu en ust sırada duruyordu fakat cok ınceledım kendıme nasıl uyarlarım bılemedım makro konusunda hıc bılgım yok cunku yenı konu acmak durumunda kaldım baslıkta cok acıklayıcı olmadı ama kusura bakmayın. yapmak ıstedıgım maıl adresını hucreden aldırıp, konu kısmını hucreden aldırıp, govde kısmınıda hucreden aldırarak dosya eksız maıl gondermek. elımde sayfayı, kıtabı, pdf ı gonderen makrolar var fakat sadece yazı gonderebılen bır makro bulmamadım ya da elımdekılerı uyarlayamadım. anlasılabılır olması adına ornek dosya ekledım ve ekran goruntusu ekledım. yarımlara sımdıden cok tesekkur ederım.

 

[kneehot]

arkadaslar ugrasa ugrasa elımdekı kodlardan ıstedıgımı yapmayı becerdım fakat outlook ta tanımlı ımzayı bı turlu sona ekletemıyorum. .Display koyarak yapabilirsiniz gibi yardımlarda aldım fakat işe yaramadı. kodu asagıya yapıstırıyorum. kodun ıcınde degısıklık yaparak tanımlı ımzayı sana getırebılırsenız cok sevınırım. yardımlara tesekkurler.


Sub mail2()
'MsgBox "MAIL GÖNDERİLİYOR.!!" & Chr(10) & Chr(10) & "LÜTFEN MAIL GÖNDERİLDİ" & Chr(10) & Chr(10) & "BİLGİSİNİ ALANA KADAR BEKLEYİNİZ.!!!", vbOKOnly
'You must add a reference to the Microsoft outlook Library
Dim OutApp As Outlook.Application
Dim OutMail As Outlook.MailItem
Dim wb As Workbook
Dim i As Integer
' Dim strdate As String
' strdate = Format(Now, "dd-mm-yy h-mm-ss")
Application.ScreenUpdating = False
For i = 4 To 4
'ActiveSheet.Copy
'Set wb = ActiveWorkbook

'With wb
'.SaveAs [i1] & " " & "BÖLGE" & " " & ActiveSheet.Name & ".xls" '"Part of " & ThisWorkbook.Name _
& " " & strdate & ".xls", xlExcel8
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(olMailItem)
With OutMail
.To = Cells(i, "g")
.CC = ""
.BCC = ""
.Subject = [e4] & " " & [f4] & " " & [e5]
.Body = [h4] & "" _
& vbNewLine & vbNewLine & [h23]
'.Attachments.Add wb.FullName
'You can add other files also like this
'.Attachments.Add ("C:\test.txt")
.Send 'or use .Display

'End With
'.ChangeFileAccess xlReadOnly
'Kill .FullName
'.Close False

End With
Next
'MsgBox "MAIL GÖNDERİLDİ.!!", vbOKOnly
Application.ScreenUpdating = False
Set OutMail = Nothing
Set OutApp = Nothing

End Sub

 

[Korhan Ayhan]

Deneyin.

Sub Mail_Gonder()
    Dim OutApp As Object
    Dim OutMail As Object
    
    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    On Error Resume Next
    With OutMail
        .Display
        .To = Sheets("gönder").Range("G4").Value
        .CC = ""
        .BCC = ""
        .Subject = Sheets("gönder").Range("H6").Value
        .HTMLBody = "Merhaba," & "<br><br>" & _
                     Sheets("gönder").Range("H4").Value & "<br>" & _
                    .HTMLBody
        .Send
    End With
    On Error GoTo 0

    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With

    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub