Kodu Revize Etmek İçin Yardım (Makro ile Mail Gönderme)

[BedriA]

Değerli Arkadaşlar,

Aşağıdaki kod ile Sayfa1'in A sütunundaki e-posta adreslerine sırayla mail atabiliyorum.

Ancak Textbox'ta yazdığım mesajda yer yer paragraf yapmama rağmen karşı tarafta tek paragraf gibi görünüyor.

İkincisi; .html dosyası olarak hazırladığım imzam da karşı tarafta görünmüyor.
Kodu revize edebilir miyiz acaba?

Örnek dosya ektedir.

Şimdiden teşekkürler.

 

[BedriA]

Kullandığım kod aşağıdadır.

Private Sub CommandButton5_Click()

On Error Resume Next
If CheckBox1 = True Then

son = Sheets("sayfa1").Range("A65536").End(3).Row
For i = 2 To son

Dim Signature, MS As Object
Dim OutApp As Outlook.Application
Dim NewMail As Outlook.MailItem
Set OutApp = CreateObject("Outlook.Application")
Set NewMail = OutApp.CreateItem(olMailItem)

Set MS = CreateObject("Scripting.FilesystemObject")
Set Signature = MS.OpenTextFile(ThisWorkbook.Path & "\imza.html", 1)




With NewMail
.To = Sayfa1.Cells(i, "A")
.Subject = TextBox3.Text
.HTMLBody = TextBox2.Text
.HTMLBody = .HTMLBody & "<p><p><p>" & Signature.readall

If TextBox5.Text <> "Dosya ekle." Then
.Attachments.Add TextBox5.Text
.Display
End If

.Save
.Send
End With

Next i
End If

son = Sheets("sayfa1").Range("A65536").End(3).Row
MsgBox "Mesajınız listenizdeki " & son - 1 & " adrese iletildi.", vbInformation, "       Postacı"


Set NewMail = Nothing
Set OutApp = Nothing

End Sub

 

[BedriA]

.HTMLBody = TextBox2.Text
.HTMLBody = .HTMLBody & "<p><p><p>" & Signature.readall

Yukarıdaki satırı aşağıdaki şekilde düzeltince paragraf sorunu çözüldü ancak imza sorunu devam ediyor.

.Body = TextBox2.Text
.Body = .Body & "<p><p><p>" & Signature.readall

 

[BedriA]

Arkadaşlar konu günceldir.

Selamlar.

 

[PLİNT]

Merhaba
Dosyanıza bakma imkanım yok ama kodlarıza göre; şöyle olabilir.

[SIZE="2"]Private Sub CommandButton5_Click()
'...
'..kodlar

For i = 2 To son
[COLOR="Red"]bd = Empty: bdc=empty [/COLOR]


'....
'....

With NewMail
.To = Sayfa1.Cells(i, "A")
.Subject = TextBox3.Text
[COLOR="Red"]For k = 0 To UBound(Split(TextBox2.Value, [COLOR="Blue"]Chr(10)[/COLOR]))
If bd <> Empty Then bdc = "<br>"
bd = bd & bdc & Split(TextBox2.Text, [COLOR="Blue"]Chr(10)[/COLOR])(k)
Next
   '.HTMLBody = bd
.HTMLBody = bd & "<p><p><p>" & Signature.readall[/COLOR]

If TextBox5.Text <> "Dosya ekle." Then

'...
'....diğer kodlarınız
'...

End Sub [/SIZE]

 

[Emir Hüseyin Çoban]

.



İmzaların uzantısı .html değil .htm dir.

.

 

[BedriA]

Çok teşekkürler arkadaşlar,

PLİNT hocanın verdiği kod ve html dosyasını htm olarak değiştirince
sorun çözüldü.

Çok sağolun.