Mail gönderirken excel formatı değişiyor

[kykbt]

Arkadaşlar Merhaba

Aşağıdaki blok kodu "Mahmut Bayram" arkadaşın kod arşiv programından aldım. Ellerine sağlık olsun.
Ancak yollayacağım bu excel sayfası mail üzerinde sutunlar uzuyor büyüyor yani orjinal halinden farklı oluyor.
Bunu nasıl önleyebiliriz.


Sub EmailSheet()
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 = ActiveSheet.UsedRange
If MyRange Is Nothing Then Exit Sub
Set FSO = CreateObject("Scripting.FilesystemObject")
TempFile = "C:\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)
OutlookMsg.HTMLBody = BodyText.ReadAll
OutlookMsg.Subject = " Tüketim Bilgileri!"
OutlookMsg.To = "kykbt@hotmail.com"
'OutlookMsg.Display
OutlookMsg.Send
'Kill TempFile
Set BodyText = Nothing
Set OutlookMsg = Nothing
Set OutlookApp = Nothing
Set FSO = Nothing
End Sub

 

[kykbt]

Arkadaşlar Henüz çözülmedi yardımlarınızı bekliyorum.