mail gönderen makroya imza ekleme

[kneehot]

Arkadaşlar merhaba. Elimde excelden mail göndermek için kullandığım bir kod var aşağıya ekledim. Fakat gönderilen maile imza eklemeyi beceremedim. Başka konular içerisinde eklenmiş çalışan kodlar buldum fakat eklemede başarılı olamadım. Yardım ederseniz çok sevinirim. Tüm yardımlara şimdiden teşekkürler.




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

 

[Emir Hüseyin Çoban]

. . .

İmzanızın dosya yolunu bilmeniz gerekiyor.

Tıkla >> #

 Tagının Kullanımı Hk.[/COLOR][/B][/URL]


. . .

 

[kneehot]

. . .

İmzanızın dosya yolunu bilmeniz gerekiyor.

Tıkla >> #

 Tagının Kullanımı Hk.[/COLOR][/B][/URL]


. . .[/QUOTE]

yolu bılıyorum sız kodu yazarsanız ve yerını belırtırsenız ben ekleyebılırım

 

[Emir Hüseyin Çoban]

. . .

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
[COLOR="red"]Set FSO = CreateObject("Scripting.FileSystemObject")
yol = "C:\Users\Hüseyin\AppData\Roaming\Microsoft\Signatures\imzaara.htm"
Set imza = FSO.OpenTextFile(yol, 1)[/COLOR]

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>" [COLOR="Red"]&  imza.readall[/COLOR]
[COLOR="Red"].display[/COLOR]
.Send
End With
On Error GoTo 0

. . .

 

[kneehot]

C:\Users\ali\AppData\Roaming\Microsoft\Signatures\imza.htm

imzanın dosya yolu

 

[kneehot]

cok tesekkur ederım. bır sıkıntı var sanırım. eklenen ımza normalde outlookta türkçe karakter sıkınsıtı yok fakat bu sekılde gonderınce asagıdakı gıbı karakter sıkıntısı cıkarıyor. bunu nasıl duzeltebılırız.

Bu e-posta mesajı ve ekleri gönderildiği kişi ya da kuruma özeldir ve gizlidir. Ayrıca hukuken de gizli olabilir. Hiçbir şekilde üçüncü kişilere açıklanamaz ve yayınlanamaz.

 

[Emir Hüseyin Çoban]

. . .

Web browser veya office dil ayarlarından olabilir.
Yeni bir imza oluşturup onun dosya yoluyla deneyiniz...

Bende şu şekilde çıkıyor...

Ekran Görüntüsü:

. . .

 

[kneehot]

peki deniyorum dediğiniz şekilde. çok teşekkür ederim.

 

[kneehot]

Tekrar merhaba. Yukarıda verilen makroyu kullanıyorum fakat makro tek hucreden yazı alıyor H4 den. Ben bır kac hucreden aldırmak istiyorum. Örnek olarak H4 dan aldıgı yazının ardından alt satırdan baslayarak D5 den, D5 bitiminde alt satırdan başlayarak F7 deki yazaları nasıl aldırabılırım. yardımcı olursanız cok sevınırım.

 

[tacettinsal]

Uzun bir aradan sonra cevap verilmiş olacak ama arayan kişiler için yardımcı olabilir. alt satıra geçmek için vbCrLf kullanılabilir.

Örneğin;

.Body = "Merhaba," & vbCrLf & "Bu mail " & Sheets(1).Range("B7") & " " & Sheets(1).Range("B4") & " dökümanı paylaşımı için gönderilmiştir." & vbCrLf & "İlgili döküman ektedir."