Otomatik Mail

[uKiGS]

Merhaba,

Örnek dosyada eklediğim tablomu Pazar günleri hariç düzenli olarak mail atıyorum. Ben bu dosyadaki tabloyu hergün sabah saat 08:00'da belirttiğim mail adresine atmasını istiyorum. Bunun için yapılabilecek bir işlem varmıdır?

Yardımlar için şimdiden teşekkürler.

 

[Tevfik_Kursun]

Merhaba,
asriakdeniz.com adresinde aradığınızı bulacağınızı düşünüyorum.
Sayın Asri hocanın mail programı oldukça yetenekli
Kolay gelsin

 

[Asri]

Sayın Tevfik_Kursun hocam önermiş bende link vereyim.

Excel i açık bırakıp runtimer prosedürü ile sürekli zamanı kontrol edip eşit olduğunda gönderim sağlanabilir.

Yada aşağıdaki konuyu inceleyebilir siniz.
http://www.excel.web.tr/f52/otomatik-dosya-mail-gonderme-programy-t164121.html

 

[uKiGS]

Merhaba sayın asri,

Ben dosyayı değil sadece dosyanın içindeki seçili olan tabloyu mail olarak göndermek istiyorum.

 

[Asri]

Merhaba sayın asri,

Ben dosyayı değil sadece dosyanın içindeki seçili olan tabloyu mail olarak göndermek istiyorum.

Yöntem olarak,

* Dosyanın sürekli açık olmadığını var sayıyorum. Bu bir sorun.
* Belli bir alanı mail gönderme dosyanın içine eklenebilir.
* Auto_open ile dosya her açıldığında belli bir alanı mail göndermesi sağlabilir. Bu durumda mail gönderimin günde bir defa çalışması sağlanmalı.
* Daha sonra yine benim yazdığım program ile otomatik gönderim sağlanabilir gibi düşünebiliriz.

Yada arkadaşlar, başka bir yöntem önerebilir.

 

[uKiGS]

Valla yöntemlerinizi evdeki pcden deniyorum ve çok başarılı buluyorum. Yardımlarınız, destekleriniz ve emeğiniz için kendi adıma çok teşekkür ederim.

Ama benim sorunum şirket bilgisayarı olması nedeniyle .exe dosyalarını yönetici şifresi olmadan çalıştıramıyorum. o yüzden bana dosya halinde bir yöntem lazım. Bununla ilgili çalışmalarınız varsa yardım etmenizi rica ederim. Çok teşekkürler.

 

[Asri]

Valla yöntemlerinizi evdeki pcden deniyorum ve çok başarılı buluyorum. Yardımlarınız, destekleriniz ve emeğiniz için kendi adıma çok teşekkür ederim.

Ama benim sorunum şirket bilgisayarı olması nedeniyle .exe dosyalarını yönetici şifresi olmadan çalıştıramıyorum. o yüzden bana dosya halinde bir yöntem lazım. Bununla ilgili çalışmalarınız varsa yardım etmenizi rica ederim. Çok teşekkürler.

Dosya ektedir.
Her gün bir defa mail gönderir. Ne zaman çalıştırdığınızın bir önemi yok.

Şu an için açıldığı gibi yada buton ile mail gönderimi için maili ekrana getiriyor.

'Maili göndermek için .send deki tırnak işaretini kaldırın.
'.send

Dosya açıldığı gibi makro devreye girer ve tarihi kontrol eder. Son gönderilen tarih bu günün tarihinden farklı ise gönderim yapar.

Sub Auto_Open()
  Call mail_secili_alan
End Sub

Sub mail_secili_alan()
      Dim wrdEdit
      Dim alan As Range
      sonsatir = Cells(Rows.Count, "A").End(3).Row
      tarih = CDate(Cells(6, "J").Value)
      
      If tarih = Date Then
         Cells(7, "J").Value = Date + 1 & " tarihinden önce gönderim yapılamaz."
         Exit Sub
      End If
      
      Set alan = Range("A1:F" & sonsatir)
            
      Set OutApp = CreateObject("Outlook.Application")
      Set OutMail = OutApp.CreateItem(0)
      With OutMail
       .To = Cells(1, "J").Value
       .CC = Cells(2, "J").Value
       .BCC = ""
       .Subject = Cells(3, "J").Value
       .Display
       
       'Maili otomatik göndermek için .send deki tırnak işaretini kaldırın.
       '.send
       .HTMLBody = Cells(4, "J").Value & RangetoHTML(alan) & .HTMLBody
       End With
       Cells(6, "J").Value = Date
       Cells(7, "J").Value = Date + 1 & " tarihinden önce gönderim yapılamaz."
      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-2013
    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]

Yardım ve emekleriniz için çok teşekkür ederim. Mükemmel bir içerik olmuş. Fakat mail adresini değiştirdiğim zaman gönderme yapamıyorum.

 

[Asri]

Yardım ve emekleriniz için çok teşekkür ederim. Mükemmel bir içerik olmuş. Fakat mail adresini değiştirdiğim zaman gönderme yapamıyorum.

Sanırım buton bağlantısını unutmuşum

Aynı gün içinde birden fazla göndereceksiniz. Gönderme tarihini silin.

Dosya güncellendi.