mailde text'e link atama

[cengiz123]

merhabalar
aşağıdaki gibi mail gönderme makrom var.
excelden belirli aralığı mail'in içine alıp gönderiyor. ancak buna ek olarak C sürücü içinde bir dosyaya link vermek istiyorum ama beceremedim.

'C:\Klasör\aaa.xlsx'>Lütfen Burayı Tıklayın
Lütfen buraya tıklayın cümlesi linkli olacak ve C:\Klasör\aaa.xlsx dosyasına atanmış/linkli olacak.

Dim Makro As Object
Dim Mail As Object
Set Makro = CreateObject("Outlook.Application")
Set Mail = Makro.CreateItem(0)
On Error Resume Next
For I = 2 To 10 ' satır
For J = 13 To 14 'Sütun
xEmailBody = xEmailBody & Chr(9) & Sheets("Program").Cells(I, J).Value
Next
xEmailBody = xEmailBody & vbNewLine
Next
xEmailBody = "Merhaba" & vbLf & "Lütfen aşağıdaki durumu inceleyiniz " & vbLf & xEmailBody
With Mail
.To = "xxx@yy.com.tr"
.CC = ""
.BCC = ""
.Subject = "kontrol"
.Body = xEmailBody & vbLf & "<a href='C:\Klasör\aaa.xlsx'>Lütfen Burayı Tıklayın </a>"
.Send
End With
Set Mail = Nothing
Set Makro = Nothing
On Error GoTo 0


şimdiden teşekkür ederim.

 

[cengiz123]

Yokmu arkadaşlar yardımcı olabilecek

 

[PLİNT]

Merhaba
Aşağıdaki gibi deneyelim

Dim Makro As Object
Dim Mail As Object
Set Makro = CreateObject("Outlook.Application")
Set Mail = Makro.CreateItem(0)
On Error Resume Next
For I = 2 To 10 ' satır
For J = 13 To 14 'Sütun
xEmailBody = xEmailBody & "<br>" & Sheets("Program").Cells(I, J).Value
Next
'xEmailBody = xEmailBody & vbNewLine
Next
xEmailBody = "Merhaba" & "<br>" & "Lütfen aşağıdaki durumu inceleyiniz " & "<br><br>" & xEmailBody
With Mail
.To = "xxx@yy.com.tr"
.CC = ""
.BCC = ""
.Subject = "kontrol"

.BodyFormat = 2
.HTMLBody = xEmailBody & "<br><br>" & "Lütfen <a href=""file:///C:\Klasör\aaa.xlsx"">Burayı</a> Tıklayın"
.Send
End With
Set Mail = Nothing
Set Makro = Nothing
On Error GoTo 0

 

[cengiz123]

merhaba Plint hocam, çok teşekkür ederim. çok faydalı oldu benim için.
tekrardan çok teşekkür ederim

 

[Haluk]

@PLİNT ;

Bende MS Outlook olmadığı için kodunuzu deneme şansım yok ancak, bir yeri dikkatimi çekti.

Kodda "Create Object" kullandığınıza göre, VBA'de Outlook için referans eklemediğinizi düşünüyorum. Bu durumda;

.BodyFormat = olFormatHTML

satırının işletilmesi sırasında VBA bu satıra geldiğinde Mail.BodyFormat = 0 olarak derleyecektir çünkü, gördüğüm kadarıyla kodun başında bir yerde söz konusu olFormatHTML sabit'e bir değer atanmamış. Bu durumda, yukarıda belirttiğim gibi siz mesaj gövdesini HTML olarak belirtmeye niyetlenmişken, VBA bunu 0 yani olFormatUnspecified olarak algılayacaktır.

Bu nedenle, kodun başında ya aşağıdaki gibi bir tanımlama yapılmalı;

Const olFormatHTML = 2

ya da, kodun ilgili satırında direkt olarak;

.BodyFormat = 2

kullanılmalı..... diye düşünüyorum.

Selamlar,

.

 

[PLİNT]

Merhaba Haluk bey
Cengiz bey in kodlarında döngü bölümünü düzelttikten sonra değer verecektim aklımdan çıkmış, deneme yapıp sonuçta müsbet olunca öyle kalmış
yukarıdaki kodlarda düzeltme yaptım, teşekkür ederim.

 

[muzos80]

Merhaba aşağıdaki mail de link vermek istiyorum ama başaramadım aşağıdaki koda ilaveten ARŞİV sayfasındaki K sütunun son hücresindeki linki alacak mail'e ekleyecek linke dosyaya ulaşmak için buraya tıklayın diyecek bir ek ilaveye ihtiyacım var


Dim oOutlookApp As Object, oItem As Object, olInsp As Object
Dim wdDoc As Object, oRng As Object
Dim xlRng As Range
Dim SonS As Long

Set oOutlookApp = CreateObject("Outlook.Application")
Set oItem = oOutlookApp.createitem(0)
SonS = Worksheets("ARŞİV").Cells(Rows.Count, "K").End(3).Row

With oItem
.display
.BodyFormat = 2
.To = "mustafabcc@hotmail.com"
.Subject = "yeni kayıt Bilgilendirme"
Set xlRng = Worksheets("ARŞİV").Range("B7:K7")
xlRng.Copy
Set olInsp = .GetInspector
Set wdDoc = olInsp.WordEditor
Set oRng = wdDoc.Range
oRng.collapse 1
oRng.Text = "giriş yapılmıştır," & vbCrLf & " "
oRng.collapse 0
oRng.Paste

Set xlRng = Worksheets("ARŞİV").Range("B" & SonS & ":K" & SonS)
xlRng.Copy
Set olInsp = .GetInspector
Set wdDoc = olInsp.WordEditor
Set oRng = wdDoc.Range
oRng.collapse 0
oRng.Text = " " & vbCrLf & " " & vbCrLf & "Kolay Gelsin,"
oRng.Paragraphs(1).Range.Paste
Application.CutCopyMode = False

.Send

End With

Set oItem = Nothing
Set oOutlookApp = Nothing
Set olInsp = Nothing
Set wdDoc = Nothing
Set xlRng = Nothing
MsgBox "E-mail gönderilmiştir.", vbInformation

 

[muzos80]

yada ( Set xlRng = Worksheets("ARŞİV").Range("B" & SonS & ":K" & SonS) ) bur da kopyaladığı K sütunundaki linki tıklamalı link olarak alacak