mail gönderme makro hata

Excel ile MS Outlook, Outlook Express, Gmail vb. programlar ile mail işlemleri hakkındaki bölüm.

mail gönderme makro hata

İleti#1)  yasartoms » 10 Ağu 2018 23:53

merhaba

bir excelim var ve belli hücrelerde mail adresleri var.

bu mail adreslerine excelldeki belli hücre aralığını alarak mail gövdesine yapıştırıp mail oluşturmasını istiyorum.
ama nedense mail adreslerini hücreden alarak mail yollayamyı beceremedim

kod aşağıda nasıl bir düzenleme yapmalıyım

çalıştırdığımda koddaki bu HTMLBody = RangetoHTML(rng) bunu sarıya boyuyor

[code][/code]
Sub Belirlenen_Hucre_Araligini_Mesaj_Gövdesine_Gonder()
'Office 2000-2010 sürümlerinde çalışır
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("detay").Range("A1:c19").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 = Cells(7, 1)
.CC = Cells(7, 2)
.BCC = ""
.Subject = ""
.HTMLBody = RangetoHTML(rng)
.Display 'göndermek için .Send
End With
On Error GoTo 0
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
Kullanıcı avatarı
yasartoms
Yeni Başlamış
 
Kayıt: 21 Tem 2018 23:27
Meslek: maliyet hesaplama
Yaş: 30
İleti: 11
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: istanbul

Cevap: mail gönderme makro hata

İleti#2)  metehan8001 » 11 Ağu 2018 00:46

Konuyu tam anlamadım. Mail adreslerine tek tek döngülü şekilde mi mail atmak istiyorsunuz yoksa cc kısmına toplu mail mi atacaksınız eger cevabınız evet ise aşağıdaki kodu değiştirin ve mail adreslerinin hangi hücre aralığında ise ona göre uyarlayın.

Kod: Tümünü seç
.To =Join(Application.Transpose(Worksheets("TOPLU MAİL").Range("B2:B8").Value), ";")' sayfa adını ve hücre aralığını değiştirin
Kullanıcı avatarı
metehan8001
Siteye Alışmış
 
Adı Soyadı:mete han
Kayıt: 18 Ekm 2011 10:30
İleti: 341
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: OSMANİYE

Cevap: Cevap: mail gönderme makro hata

İleti#3)  yasartoms » 11 Ağu 2018 02:24

metehan8001 yazdı:Konuyu tam anlamadım. Mail adreslerine tek tek döngülü şekilde mi mail atmak istiyorsunuz yoksa cc kısmına toplu mail mi atacaksınız eger cevabınız evet ise aşağıdaki kodu değiştirin ve mail adreslerinin hangi hücre aralığında ise ona göre uyarlayın.

Kod: Tümünü seç
.To =Join(Application.Transpose(Worksheets("TOPLU MAİL").Range("B2:B8").Value), ";")' sayfa adını ve hücre aralığını değiştirin


To = g1
.CC = g2
.BCC =
.Subject = g3

olsun istiyorum ama kodu çalıştırdığımda

.HTMLBody = RangetoHTML(rng) bu kodda sarı yanıyor kod çalışmıyor.
Kullanıcı avatarı
yasartoms
Yeni Başlamış
 
Kayıt: 21 Tem 2018 23:27
Meslek: maliyet hesaplama
Yaş: 30
İleti: 11
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: istanbul

Cevap: mail gönderme makro hata

İleti#4)  metehan8001 » 11 Ağu 2018 08:06

RangetoHTML için function modülde yoksa aşağıdaki kodu da çalıştığınız sayfanın makro modülüne yapıştırın.
Kod: Tümünü seç
Function RangetoHTML(rng As Range)
    'Office 2000-2016 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
Kullanıcı avatarı
metehan8001
Siteye Alışmış
 
Adı Soyadı:mete han
Kayıt: 18 Ekm 2011 10:30
İleti: 341
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: OSMANİYE

REKLAM
Excel Logo XML Oluşturucu
Logo Object Designer ile Uyarlama

Cevap: Cevap: mail gönderme makro hata

İleti#5)  yasartoms » 12 Ağu 2018 01:05

metehan8001 yazdı:RangetoHTML için function modülde yoksa aşağıdaki kodu da çalıştığınız sayfanın makro modülüne yapıştırın.
Kod: Tümünü seç
Function RangetoHTML(rng As Range)
    'Office 2000-2016 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


çok teşekkürler elinize sağlık
Kullanıcı avatarı
yasartoms
Yeni Başlamış
 
Kayıt: 21 Tem 2018 23:27
Meslek: maliyet hesaplama
Yaş: 30
İleti: 11
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: istanbul


Forum Excel ile Mail İşlemleri

Online Kullanıcılar

Bu forumu görüntüleyenler: Kayıtlı kullanıcı yok ve 1 misafir

cron
Bumerang - Yazarkafe