Mail gönderilmesi hk.

[1903emre34@gmail.com]

Merhaba,

Aşağıdaki kodlar kullanarak excel sayfasından mail gönderiyorum, sıkıntı şu imza bölümüyle (excel sayfasında yer alıyor), Command Button 1 basınca mailde çift taraflı olmaktadır, (resimdeki gibi) ve sizlerden isteğim mail başlangıç "Merhaba" kelimesi outlook gelmesi kodlarda değişiklik yapabilir miyiz?



Private Sub ComboBox1_Change()

End Sub

Private Sub CommandButton1_Click()
kime = ""

For j = 0 To ListBox2.ListCount - 1
If ListBox2.Selected(j) Then
kime = kime & ListBox2.List(j) & ";"
End If
Next j
bilgi = ""
For j = 0 To ListBox3.ListCount - 1
If ListBox3.Selected(j) Then
bilgi = bilgi & ListBox3.List(j) & ";"
End If
Next j

Call mail_gonder
For m = 1 To 3
For i = 0 To Me.Controls("ListBox" & m).ListCount
Me.Controls("ListBox" & m).Selected(i) = False
Next i
Next
End Sub

Private Sub ListBox1_Click()

End Sub

Private Sub UserForm_Initialize()

'LİSTBOX 1
ListBox1.ColumnCount = 6
ListBox1.ColumnWidths = "1500"
ListBox1.RowSource = "İMZALAR!A1:F" & Sheets("İMZALAR").[a65536].End(xlUp).Row

'LİSTBOX 2
ListBox2.ColumnCount = 1
ListBox2.ColumnWidths = "150"
ListBox2.RowSource = "MAİLLER!A1:A" & Sheets("MAİLLER").[a65536].End(xlUp).Row

'LİSTBOX 3
ListBox3.ColumnCount = 1
ListBox3.ColumnWidths = "150"
ListBox3.RowSource = "MAİLLER!A1:A" & Sheets("MAİLLER").[a65536].End(xlUp).Row

Application.ScreenUpdating = False
Range("A:F").Select
ActiveWorkbook.Worksheets("İMZALAR").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("İMZALAR").Sort.SortFields.Add Key:=Range("A1"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("İMZALAR").Sort
.SetRange Range("A:F")
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("A1").Select
Application.ScreenUpdating = True

End Sub

Sub mail_gonder()
On Error GoTo mailatma
Dim imza As Range
Set evnout = CreateObject("Outlook.Application")
Set evnmailitem = evnout.CreateItem(0)
Set shimza = Sheets("İMZALAR")
sonsatir = shimza.Cells(Rows.Count, "A").End(3).Row
satir = 0 + ListBox1.ListIndex
satir = satir + 1
Set imza = Range("B23:B30")
baslik = Range("A" & satir).Value
baslik = Replace(baslik, "{AY}", ComboBox1.Text)
With evnmailitem
baslik2 = Replace(baslik, "firmasının", "")
.Subject = Trim(Replace(baslik2, "mail ortamında gönderirmisin", ""))
.To = kime
.cc = bilgi
.BodyFormat = 2
.display
Set wrdEdit = evnout.ActiveInspector.WordEditor

ActiveSheet.Shapes.Range(Array("Resimimza")).Select
Selection.Copy
wrdEdit.Application.Selection.Paste

'.Attachments.Add maildosya
'.Htmlbody = "<br>" & RangetoHTML(alan) & .Htmlbody
.Htmlbody = "<br>" & baslik & RangetoHTML(imza) & .Htmlbody


'.send
End With
mailatma:
Set evnmailitem = Nothing
Set evnout = Nothing
Set wrdEdit = Nothing
End Sub

 

[Asri]

Ya koddaki mailimza ekleme bölümünü kaldırın. Yada outlook da otomatik mail imza yı kaldırın.

Merhaba için aşağıdaki şekilde deneyin.

.Htmlbody = "Merhaba <br>" & baslik & RangetoHTML(imza) & .Htmlbody