mail gönderme kod yardımı

[spacebar]

arkadaşlar günaydın. bir mutabakat formu dosyam var. bunu makroyla (buton ile) mail atmak istiyorum. ama kodun bir satırında hata mesajı veriyor. sanırım işyerinde mail sunucu ayarıyla ilgili bir sorun.yardımcı olursanız sevinirim. teşekkürler....



Sub Mail_Range_Outlook_Body()
' Don't forget to copy the function RangetoHTML in the module.
' Working in Office 2000-2010
Dim rng As Range
Dim OutApp As Object
Dim OutMail As Object

With Application
.EnableEvents = False
.ScreenUpdating = False
End With

Set rng = Nothing
On Error Resume Next
Set rng = Sheets("Bs form").Range("A1:I32").SpecialCells(xlCellTypeVisible)
On Error GoTo 0

If rng Is Nothing Then
MsgBox "The selection is not a range or the sheet is protected" & _
vbNewLine & "please correct and try again.", vbOKOnly
Exit Sub
End If

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

On Error Resume Next
With OutMail
.to = ThisWorkbook.Sheets("Bs form").Range("H55").Value
.CC = ""
.BCC = ""
.Subject = "BA/BS MUTABAKATI HK. Lütfen mail ile cevap veriniz."
.HTMLBody = RangetoHTML(rng)
.Send 'or use .Send
End With
On Error GoTo 0

With Application
.EnableEvents = True
.ScreenUpdating = True
End With

Set OutMail = Nothing
Set OutApp = Nothing
End Sub





.HTMLBody = RangetoHTML(rng) satırında hata veriyor.

 

[nsertoglu]

aşağıdaki metinde "(xlCellTypeVisi ble)" yerine "(xlCellTypeVisible)" yazmayı denediniz mi? yoksa siz excel.web.tr ye aktarırken mi "visible" içinde boşluk oluşmuş?

**Set rng = Sheets("Bs form").Range("A1:I32").SpecialCells(xlCellTypeVisi ble)**

 

[spacebar]

teşekkür ederim ilginize. orada kopyala yapıştır yaparken boşluk oluşmuş.

 

[spacebar]

arkadaşlar bugün bitirmem gerekiyor bu işi. yardımcı olacak kimse yokmu ?

 

[Murat OSMA]

Module içerisinde RangetoHTML(rng) fonksiyonu var mı ? Sadece bu kodlarınız varsa olmaz.

 

[spacebar]

aslında aynı makroyu başka bir belgede kullanıyorum. onda bir sorun olmuyor. bu belgede sadece aralıklar ve sayfa ismi değişik. onları düzelttim. ama hata mesajı veriyor.

 

[Murat OSMA]

Anladım. Dosyanızı göndermenizde bir sakınca yoksa görebilir miyim ?

 

[spacebar]

üstad ekte gönderiyorum. teşekkür ederim.

 

[Murat OSMA]

Öğlen iyi ki sizden bir cevap gelmesini beklememişim..

Yarın bakarım artık iftar saati geldi...

İyi akşamlar...

 

[spacebar]

murat bey işyerinde internete girmek mümkün olmuyor.(şirket politikası gereği ) ilginize teşekkür ederim. iyi akşamlar...

 

[Murat OSMA]

Dosyanızı indirdim ve daha önce dediğim gibi;

Module içerisinde RangetoHTML(rng) fonksiyonu var mı ? Sadece bu kodlarınız varsa olmaz.

Dosyanız ek'teki dosya gibi olmalı... Orijinal dosyadaki FunctionModule Modülündeki RangetoHTML fonksiyonu eksik.

Yani şu kodlar;

Option Explicit

Function RangetoHTML(rng As Range)

'Office 2000-2010 sürümlerinde çalışır
    Dim fso As Object
    Dim ts As Object
    Dim TempFile As String
    Dim TempWB As Workbook
     TempFile = Environ$("temp") & "\" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
 
   ' Kopya aralığı ve geçmiş verileri yeni bir çalışma kitabı oluşturamazsınız
    rng.Copy
    Set TempWB = Workbooks.Add(1)
    With TempWB.Sheets(1)
        .Cells(1).PasteSpecial Paste:=8
        .Cells(1).PasteSpecial xlPasteValues, , False, False
        .Cells(1).PasteSpecial xlPasteFormats, , False, False
        .Cells(1).Select
        Application.CutCopyMode = False
        On Error Resume Next
        .DrawingObjects.Visible = True
        .DrawingObjects.Delete
        On Error GoTo 0
    End With
 
    'Sayfayı htm dosyası olarak yayınla
    With TempWB.PublishObjects.Add( _
         SourceType:=xlSourceRange, _
         Filename:=TempFile, _
         Sheet:=TempWB.Sheets(1).Name, _
         Source:=TempWB.Sheets(1).UsedRange.Address, _
         HtmlType:=xlHtmlStatic)
        .Publish (True)
    End With
 
    'RangetoHTML içine htm dosyası olan tüm verileri oku
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
    RangetoHTML = ts.readall
    ts.Close
    RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
                          "align=left x:publishsource=")
 
    'TempWB'yi kapat
    TempWB.Close savechanges:=False
 
    'htm dosyası olan bu fonksiyonu sil
    Kill TempFile
 
    Set ts = Nothing
    Set fso = Nothing
    Set TempWB = Nothing
End Function

Örnek bir dosya ekliyorum oradaki Module'leri inceleyiniz...

 

[spacebar]

bu makroyu başka bir belgede kullanabildiğim halde bu belgede neden hata veriyor.

 

[spacebar]

murat bey çok teşekkür ederim. emeğinize ve bilginize sağlık.