BIR TABLOYU MAILIN ICINE AKTARMAK

[melwitch]

Güzel bir hafta dileyerek sözüme başlamak istedim.

Arkadaşlar benim bir sorunum vardı ve bu sorunu bir türlü çözemedim. Eski başlık altından devam edecektim ama onuda bulamadığım için tekrar başlık açmak zorunda kaldım kusura bakmayın.

Ben bir çalışma kitabında aktif sheet içerisinde yer alan tabloyu mailin içine aktarmak istiyorum. Ancak tablonun mesela "G1" sütununda yazılan açıklamayıda hemen altına yazdırmasını istiyorum. Sheeti dosya olarak göndermek bir çözüm ama iş görmediğinden direkt mailin içerisine yazdırılması gerekmekte. Bu arada mailin içerisine aktarılan tablo ve açıklama sola yanışık vaziyette olması gerekiyor.

Aşağıdaki kod bir önceki çalışmada yapılan koddur. Ancak bu kodla maalesef tabloyu mailin içine yazdırmayı başardım (ancak sola yanaşık değil ortalayarak yazdı) ancak bir türlü "G1" hücresine girilen açıklamayı tablonun altına yazdıramadım. Başka bilgisayarda çalışıyormuş ancak nedense benimkinde ne yaptımsa çalışmadı. Ben C sürücüsünü kullanamıyorum. (C sürücüsü kısıtlaması var) Belki ondan oluyor dedim ama belki sizlerin yazacağı başka bir kodla bu sorunu çözmem mümkün olur diye düşündüm.

Aşağıda hazırlanan kodu veriyorum. Bu arada tablonun "A1:F65536" aralığında olduğu varsayılmış ve açıklamanında "G1" de olduğu varsayılmıştır.

Þimdiden teşekkürler


Sub EmailSheet3()
Dim OutlookApp As Object, OutlookMsg As Object
Dim FSO As Object
Dim BodyText1 As Object, BodyText2 As Object
Dim MyRange As Range
Dim TempFile1 As String, TempFile2 As String
Dim NoF As Long

NoF = Range("F65536").Cells.End(xlUp).Row
TempFile1 = "E:\TempHTML1.htm"
TempFile2 = "E:\TempHTML2.htm"

Set FSO = CreateObject("Scripting.FilesystemObject")

On Error Resume Next

Set MyRange = ActiveSheet.Range("A1:F" & NoF)
If MyRange Is Nothing Then Exit Sub
ActiveWorkbook.PublishObjects.Add _
(4, TempFile1, MyRange.Parent.Name, MyRange.Address, 0, "", "").Publish True

Set MyRange = ActiveSheet.Range("G1")
ActiveWorkbook.PublishObjects.Add _
(4, TempFile2, MyRange.Parent.Name, MyRange.Address, 0, "", "").Publish True

Set OutlookApp = CreateObject("Outlook.Application")
Set OutlookMsg = OutlookApp.CreateItem(0)
Set BodyText1 = FSO.OpenTextFile(TempFile1, 1)
Set BodyText2 = FSO.OpenTextFile(TempFile2, 1)

With OutlookMsg
.HTMLBody = BodyText1.ReadAll & BodyText2.ReadAll
.Subject = Range("A2").Text & " " & Range("U1").Text
.To = ""
.CC = ""
.Display
End With

Kill TempFile1
Kill TempFile2

Set BodyText2 = Nothing
Set BodyText1 = Nothing
Set OutlookMsg = Nothing
Set OutlookApp = Nothing
Set MyRange = Nothing
Set FSO = Nothing
End Sub

 

[Haluk]

Merhaba;

Anlaşılan problem devam ediyor....

Peki, kodlarda aşağıdaki gibi bir değişiklik yapılınca ne oluyor, deneyebilirmisin ?

[vb:1:ac3cf74a8e]

.....
...
With OutlookMsg
.HTMLBody = BodyText2.ReadAll & BodyText1.ReadAll
.Subject = Range("A2").Text & " " & Range("U1").Text
.To = ""
...
..
[/vb:1:ac3cf74a8e]

 

[melwitch]

Raider nihayet bana kimin yardımcı olduğunu buldum. Ben önceki yazışmayı bulamadım ve bir türlü nickinide hatırlayamadım ki soruyu sorabileyim. Neyseki sen yine farkettin Teşekkürler tekrar ilgilendiğin için.

Gelelim probleme. Denedim verdiğin kodu fakat gülecekmisin , ağlayacakmısın bilmiyorum ama bu seferde açıklama çıktı tablo ortada yok :agla: :agla: :agla:

ben ağlamaya başladım bile. :kafa:

 

[Haluk]

Doğrusu tuhaf...

Peki, o satırı aşağıdaki ile değiştirsen ...

[vb:1:f698af264e] .HTMLBody = BodyText1.ReadAll & Range("G1")
[/vb:1:f698af264e]

 

[melwitch]

Þimdide tablo geliyor ama açıklama yok yine :kafa:

acaba başka türlü hazırlanabilirmi bu makro. belki farklı bir makro türü denense başarılı olabilir. txt dosyasının ilkini yazdırıyor ama neden ikinci verilen komutu dinlemiyor bende anlamış değilim çünkü. Yokmudur başka yolu sence. mesela bodytext1 veya bodytext2 yaratılmadan yapma yolu.