Mail Gönderme Hatası

[uKiGS]

Merhaba,

siteden aldığım bir makro vardı fakat kimden aldığımı tam hatırlamıyorum. otomatik olarak mail gönderiyordum. bilgisayar güncelleme yaptığı için windows 10 a geçiş yaptık. sürekli bir hata almaktayım. işin içinden çıkamadım. yardımlarınızı rica ederim.

Kullandığım makro bu. Mail gönder tuşuna bastığımda göndermiyor.

Private Sub CommandButton1_Click()
Dim Sayfa As Worksheet
Dim Alan As Range
Dim daralan As Range

If Cells(2, 11) = "" Then GoTo HATA

On Error GoTo HATA

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

saydir = Sayfa1.Range("B" & Rows.Count).End(3).Row
DinamikAlan = "B2:" & "G" & saydir
Set Alan = Worksheets("Sayfa1").Range(DinamikAlan)

Set Sayfa = ActiveSheet

With Alan

.Parent.Select
Set daralan = ActiveCell

.Select
ActiveWorkbook.EnvelopeVisible = True
With .Parent.MailEnvelope

.Introduction = "Merhaba," & _
vbCrLf & " Efesan Liman sahasında bulunan gümrük ve stok araç adetleri marka ve model bazında aşağıdaki tabloda bilginize sunulmuştur." & _
vbCrLf & " Saygılarımızla,"
With .Item
.SentOnBehalfOfName = "cenkungan@gmail.com"
.To = Cells(2, 11)
.CC = Cells(3, 11)
.BCC = Cells(4, 11)
.Subject = Cells(1, 11)
.send
End With

End With

daralan.Select
End With

Sayfa.Select

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


End Sub

 

[cems]

Soru başlığı benzer problemlerde sorunun bulunmasına uygun değil biliyorsunuz...

Kodların başında ve sonunda

kullanmanız daha doğru olurdu.

Diğer yandan , sorunuzun kısmi cevabı şurada verilmiş olabilir.

http://www.excel.web.tr/f48/makro-bulunamady-hatasy-t169176.html#post924457

Yani alıcı gösterilmedi ise bu kodların başında çıkış yapılması gereken durumdur.

 

[uKiGS]

Windows 10a geçmeden önce kullandığım makro sorunsuz çalışıyordu. Şimdi dosyayı kullandığımda mail gönder butonuna tıkladığımda direkt olarak From To CC BCC kısımları açılıyor ve konuyada dosyanın adını yazıyor.

dosyayı gönderiyorum bir bakarsanız sevinirim.

 

[uKiGS]

varmı yardım edebilecek kimse?

sayın cems'in dediği konuya baktım fakat sorun onunla alakalı değil sanırım yine aynı hataları alıyorum.

 

[uKiGS]

Mail gönder butonuna tıkladığımda yukarıdaki from sent kısmı açılıyor.

 

[uKiGS]

Arkadaşlar sıkıştırıyorum farkındayım ama gerçekten konu benim için acil. Yardım edebilecek birileri varsa ve ederlerse çok memnun olurum.

 

[Asri]

Bu şekilde deneyiniz.

Sub mail_secili_alan()
      Dim wrdEdit
      Dim alan As Range

      Set alan = Range("B1:H26")
            
      Set OutApp = CreateObject("Outlook.Application")
      Set Outmail = OutApp.CreateItem(0)
       With Outmail
         .SentOnBehalfOfName = "sizinmail@aaa"
         .Recipients.Add (Cells(2, 11))
         .Recipients.Add (Cells(3, 11))
         .Subject = Cells(1, 11)
         .Display
          mesaj = "Merhaba," & _
            "<br>" & " sahasında bulunan gümrük ve stok araç adetleri marka ve model bazında aşağıdaki tabloda bilginize sunulmuştur." & _
            "<br>" & " Saygılarımızla,"
         .HTMLBody = mesaj & RangetoHTML(alan) & .HTMLBody
         'Maili otomatik göndermek için .send deki tırnak işaretini kaldırın.
         '.send
       End With
      
      Set wrdEdit = Nothing
      Set Outmail = Nothing
      Set OutApp = Nothing
End Sub

Function RangetoHTML(rng As Range)
' Changed by Ron de Bruin 28-Oct-2006
' Working in Office 2000-2016
    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"

    'Copy the range and create a new workbook to past the data in
    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

    'Publish the sheet to a htm file
    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

    'Read all data from the htm file into RangetoHTML
    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=")

    'Close TempWB
    TempWB.Close savechanges:=False

    'Delete the htm file we used in this function
    Kill TempFile

    Set ts = Nothing
    Set fso = Nothing
    Set TempWB = Nothing
End Function

 

[uKiGS]

Sayın asri dediğiniz şekilde denedim fakat göndermiyor yine. Yukarıda resimdeki gibi from sent kısmı gelmiyor ama mailide göndermiyor ne yazık ki.

 

[Asri]

Sayın asri dediğiniz şekilde denedim fakat göndermiyor yine. Yukarıda resimdeki gibi from sent kısmı gelmiyor ama mailide göndermiyor ne yazık ki.

Koddaki bu bölümü çıkarıp dener misiniz?
Bu da olmuyor ise Outlook tarafında bir sorun olabilir diye düşünüyorum.

Normalde excel in içinden kod kullanmadan dosya /paylaş/ eposta/ ek olarak dediğiniz de gidecek mail düzgün açılıyor mu)

.SentOnBehalfOfName = "sizinmail@aaa"

 

[uKiGS]

ekteki dosyamda bir makrom var zaten onunla sorunsuz olarak kullanıyordum. dün gece şirket bilgisayarlarına windows 10 güncellemesi geldi o yüzden gönderim yapmıyor bugün. koddaki o bölümü çıkartırsam mail adresi istediğim mail olmayacak bu da benim bir işime yaramayacak. kodda o kısmı çıkartıpta denediğimde de yukarıda resmini atmış olduğum hata ile karşılaşıyorum.

 

[Asri]

ekteki dosyamda bir makrom var zaten onunla sorunsuz olarak kullanıyordum. dün gece şirket bilgisayarlarına windows 10 güncellemesi geldi o yüzden gönderim yapmıyor bugün. koddaki o bölümü çıkartırsam mail adresi istediğim mail olmayacak bu da benim bir işime yaramayacak.

İlk aşamada, işinize yarayıp yaramamasının bir önemi yok.
Önce sorunu tespit edin sonra çözümü bulunur.

Siz yazdıklarımı denediniz mi?

 

[uKiGS]

Denedim yazdıklarınızı ama olmadı

 

[Asri]

Denedim yazdıklarınızı ama olmadı

Olmadı derken, bu da mı olmadı.

Normalde excel in içinden kod kullanmadan dosya /paylaş/ eposta/ ek olarak dediğiniz de gidecek mail düzgün açılıyor mu)

 

[uKiGS]

evet açılıyor düzgün olarak.

 

[uKiGS]

Bakma şansınız oldu mu sayın asri?

 

[Asri]

Bakma şansınız oldu mu sayın asri?

Win10 excelden gelen mail istediğini tam anlamıyor sanırım.
sebebini bilmiyorum.

Bu konuda başka arkadaşların fikirleri var ise beklemek lazım.
Yada farklı mail gönderme kodları denemek lazım.

win7 ve win8.1 proda bu şekilde bir sorun yaşamadım. Win10 denemedim.

 

[uKiGS]

Anlıyorum. peki dosyaya göre bir excel oluştursanız ve ben yarın iş yerinde onu denesem olur mu ?

 

[Asri]

Anlıyorum. peki dosyaya göre bir excel oluştursanız ve ben yarın iş yerinde onu denesem olur mu ?

İlk mesajımda secili_alan olarak farklı bir kod oluşturmuştum.
Aynı yöntemi sürekli kullanıyorum hiç bu tür bir sorun görmedim.

 

[uKiGS]

seçili alanı B2:H26 yaptığınız kodu denediğimde hata resmindeki pencere açılmıyor fakat mailide göndermiyor. hatayı düzelttiniz çok güzel elinize sağlık fakat mail hala gitmiyor

 

[uKiGS]

http://www.excel.web.tr/showpost.php?p=902042&postcount=7

Sayın asri benim size sorduğum ve sizin yaptığınız böyle bir örnek mevcuttu.

Bunu bugün denediğimde excel açıldığında otomatik olarak outlook yeni mail gönderme sayfası açılıp tabloyu ekliyor. ama mail gönder butonuna bastığımda yine aynı hatayı alıyorum. Belki buradan bir şey çıkabilir