Merhaba Arkadaşlar,
Bir excel sayfasından, ms outlook ile mail gönderirken aşağıdaki kodu kullanıyordum. Kodda mail gövdesine yerleşecek excel hücreleri alanını önceden belirtmem gerekiyor. C7 den J100 e kadar
Şimdi ise; mail gövdesine yerleşecek olan excel hücreleri alanı değişken olsun istiyorum. Şöyle ki;
C7 hücresinden başlasın ve C sütunundaki ilk boş hücreye kadar belirlesin, aynı şekilde J sütununa kadar olan bölgeyi mail gövdesi olarak hazırlasın. yardımlarınız için şimdiden teşekkürler.
Kullandığım kod:
Sub EmailSheet3()
Dim OutlookApp As Object, OutlookMsg As Object
Dim FSO As Object, BodyText As Object
Dim MyRange As Range, TempFile As String
On Error Resume Next
Set MyRange = Sheets("Sayfa4").Range("C7:J100")
If MyRange Is Nothing Then Exit Sub
Set FSO = CreateObject("Scripting.FilesystemObject")
TempFile = "C:\MAIL3\TempHTML.htm"
ActiveWorkbook.PublishObjects.Add _
(4, TempFile, MyRange.Parent.Name, MyRange.Address, 0, "", "").Publish True
Set OutlookApp = CreateObject("Outlook.Application")
Set OutlookMsg = OutlookApp.CreateItem(0)
Set BodyText = FSO.OpenTextFile(TempFile, 1)
With OutlookMsg
.HTMLBody = BodyText.ReadAll
.Subject = "TAAHHUDU BITEN ABONELIKLER ADEDI" & " " & Range("R4").Text
.To = "oktaycikis@gmail.com"
.CC = "cebrail@gmail.com"
.Send
End With
Kill TempFile
Set BodyText = Nothing
Set OutlookMsg = Nothing
Set OutlookApp = Nothing
Set FSO = Nothing
End Sub
Bir excel sayfasından, ms outlook ile mail gönderirken aşağıdaki kodu kullanıyordum. Kodda mail gövdesine yerleşecek excel hücreleri alanını önceden belirtmem gerekiyor. C7 den J100 e kadar
Şimdi ise; mail gövdesine yerleşecek olan excel hücreleri alanı değişken olsun istiyorum. Şöyle ki;
C7 hücresinden başlasın ve C sütunundaki ilk boş hücreye kadar belirlesin, aynı şekilde J sütununa kadar olan bölgeyi mail gövdesi olarak hazırlasın. yardımlarınız için şimdiden teşekkürler.
Kullandığım kod:
Sub EmailSheet3()
Dim OutlookApp As Object, OutlookMsg As Object
Dim FSO As Object, BodyText As Object
Dim MyRange As Range, TempFile As String
On Error Resume Next
Set MyRange = Sheets("Sayfa4").Range("C7:J100")
If MyRange Is Nothing Then Exit Sub
Set FSO = CreateObject("Scripting.FilesystemObject")
TempFile = "C:\MAIL3\TempHTML.htm"
ActiveWorkbook.PublishObjects.Add _
(4, TempFile, MyRange.Parent.Name, MyRange.Address, 0, "", "").Publish True
Set OutlookApp = CreateObject("Outlook.Application")
Set OutlookMsg = OutlookApp.CreateItem(0)
Set BodyText = FSO.OpenTextFile(TempFile, 1)
With OutlookMsg
.HTMLBody = BodyText.ReadAll
.Subject = "TAAHHUDU BITEN ABONELIKLER ADEDI" & " " & Range("R4").Text
.To = "oktaycikis@gmail.com"
.CC = "cebrail@gmail.com"
.Send
End With
Kill TempFile
Set BodyText = Nothing
Set OutlookMsg = Nothing
Set OutlookApp = Nothing
Set FSO = Nothing
End Sub
